big DOS like game

General FreeBASIC programming questions.
bluatigro
Posts: 564
Joined: Apr 25, 2012 10:35
Location: netherlands

big DOS like game

Postby bluatigro » Sep 12, 2018 9:48

trying to create a DOS like game whit large char's

first step :
ALL ascii char's big

Code: Select all

'' bluatigro 12 sept 2018
'' game 4

#include "color.bas"
#include "_big_chars.bas"

dim as double qx = winx / 84
dim as double qy = winy / 29
dim as double qdx = qx / 8
dim as double qdy = qy / 8

dim as double x , y
dim as string in

dim as ubyte p( 84 , 29 )

do
  cls
  select case in
    case "w"
      char += 1
    case "x"
      char -= 1
    case else
      char = val( in )
  end select
  text winx / 2 , 100 , trim( str( char ) ) , 5 , white
  text2 winx / 2 , winy / 2 , chr( char ) , 30 , 20 , white
  input "ASCII CHAR NR [ 0 ... 255 or w x q = quit ] : " ; in
loop until in = "q"



Code: Select all

'' bluatigro 12 sept 2018
'' automatic big text

dim shared as integer letterpart( 255 , 8 )
dim as integer char , ix , iy

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

DIM shared AS INTEGER winx, winy, bitdepth , nu
SCREENINFO winx , winy , bitdepth
SCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREEN

for char = 0 to 255
  cls
  print chr( char )
  for ix = 0 to 8
    for iy = 0 to 8
      if point( ix , iy ) <> -16777216 then
        letterpart( char , iy ) += 2 ^ ix
      end if
    next iy
  next ix
next char

sub digit( a as double , b as double _
  , q as double , d as double  , kl as ulong )
  dim as double x , y
  for x = 0 to 8
    for y = 0 to 8
      if letterpart( q , y ) and 2 ^ x then
        circle( a + ( x - 4 ) * d , b + ( y - 4 ) * d ) _
        , d / 2 , kl ,,,, f
      end if
    next y
  next x
end sub

sub text( a as double , b as double , txt as zstring _
  , d as double , kl as ulong )
  dim as double l = len( txt ) , x
  for x = 1 to l
    digit a + ( x - l / 2 - 1 ) * d * 8 , b _
    , asc( mid( txt , x , 1 ) ) , d , kl
  next x
end sub

sub digit2( a as double , b as double _
  , q as double , dx as double  , dy as double , kl as ulong )
  dim as double x , y
  for x = 0 to 8
    for y = 0 to 8
      if letterpart( q , y ) and 2 ^ x then
        circle( a + ( x - 4 ) * dx , b + ( y - 4 ) * dy ) _
        , dx / 2 , kl ,,,dy/dx, f
      end if
    next y
  next x
end sub

sub text2( a as double , b as double , txt as zstring _
  , dx as double , dy as double , kl as ulong )
  dim as double l = len( txt ) , x
  for x = 1 to l
    digit2 a + ( x - l / 2 - 1 ) * x * 8 , b _
    , asc( mid( txt , x , 1 ) ) , dx , dy , kl
  next x
end sub

Code: Select all

''bluatigro 13 feb 2015
''color.bas

''some colors consts + functions

#ifndef COLOR_H
#define COLOR_H


const as Single pi    = CSng( atn( 1.0 ) * 4.0 )
const as Single golden_ratio = CSng( ( sqr(5.0) - 1.0 ) / 2.0 )

function rad( x as single ) as single
''help function degrees to radians
  return x * pi / 180
end function

function degrees( x as single ) as single
  return x * 180 / pi
end function

function range( l as single , h as single ) as single
  return rnd * ( h - l ) + l
end function

sub rotate( byref k as single , byref l as single , deg as single )
  dim as single s , c , hk , hl
  s = sin( rad( deg ) )
  c = cos( rad( deg ) )
  hk = k * c - l * s
  hl = k * s + l * c
  k = hk
  l = hl
end sub

''primary colors
const as ulong black      = &hff000000
const as ulong red        = &hffff0000
const as ulong green      = &hff00ff00
const as ulong yellow     = &hffffff00
const as ulong blue       = &hff0000ff
const as ulong magenta    = &hffff00ff
const as ulong cyan       = &hff00ffff
const as ulong white      = &hffffffff
''mix colors
const as ulong orange     = &hffff7f00
const as ulong gray       = &hff7f7f7f
const as ulong pink       = &hffff7f7f
const as ulong purple     = &hff7f007f
const as ulong darkRed    = &hff7f0000
const as ulong darkYellow = &hff7f7f00
const as ulong darkGreen  = &hff007f00
const as ulong darkBlue   = &hff00007f

function mix( kla as ulong , f as single , klb as ulong ) as ulong
  dim as ulong ra , ga , ba , rb , gb , bb , r , g , b
  ra = ( kla shr 16 ) and 255
  ga = ( kla shr 8 ) and 255
  ba = kla and 255
  rb = ( klb shr 16 ) and 255
  gb = ( klb shr 8 ) and 255
  bb = klb and 255
  r = ra + ( rb - ra ) * f
  g = ga + ( gb - ga ) * f
  b = ba + ( bb - ba ) * f
  return rgb( r and 255 , g and 255 , b and 255 )
end function

function rainbow( x as single ) as ulong
  dim as ulong r , g , b
  r = sin( rad( x ) ) * 127 + 128
  g = sin( rad( x - 120 ) ) * 127 + 128
  b = sin( rad( x + 120 ) ) * 127 + 128
  return rgb( r and 255 , g and 255 , b and 255 )
end function

function rndcolor() as ulong
  return rgb( rnd * 255 , rnd * 255 , rnd * 255 )
end function

#endif
bluatigro
Posts: 564
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: big DOS like game

Postby bluatigro » Sep 13, 2018 9:30

update :
input and output on big DOS screen

i made a bigDOS example chatbot

Code: Select all

DIM shared as string a( 20 ) , b( 20 ) , zin( 50 , 3 ) , word( 40 ) , telword
#include "big_dos.bas"
PRINTtext "Blua Tigro"
PRINTtext "presents :"
PRINTtext "Dr. Eliza ."
PRINTtext "A.I. simulation of a psychiatrist ."
printtext "[ Please type without .,!? ]"
dim as integer maxwoord
dim as string aq , bq
declare sub split( z as string )
sub split( z as string )
  dim as integer p , telword = 0
  while instr( z , " " ) <> 0
    p = instr( z , " " )
    word( telword ) = left( z , p - 1 )
    z = right( z , len( z ) - p )
    telword += 1
  wend
end sub

maxwoord = 1
WHILE a( maxwoord - 1 ) <> "="
'spiegeldata inlezen
''read mirror data
  READ aq , bq
  a( maxwoord ) = aq
  b( maxwoord ) = bq
  maxwoord = maxwoord + 1
WEND
dim as integer maxzin , t
dim as string z
maxzin = 1
WHILE zin( maxzin - 1 , 0 ) <> "="
'sleutels en reactie zinnen inlezen
''read keys and reaction
  FOR t = 0 TO 3
    READ z
    zin( maxzin , t ) = z
  NEXT t
  maxzin = maxzin + 1
WEND
dim as string antwoord , mijn
dim as integer ai , e , qq
in = "qq"
PRINTtext "Dokter Eliza is there ."
printtext "type bey to end sesion ."
while in <> ""
  color pink , black
  in = inputtext( "[ push enter to quit ]" )
  z = in
  ai = 0
  in = Lcase( in + " " )
  FOR t = 0 TO maxzin - 1
  'alle sleutels langslopen
  'loop al keys
    IF INSTR( in , zin( t, 0 ) ) <> 0 THEN
    'sleutel gevonden ?
    'key fount ?
      antwoord = zin( t , INT( RND * 2.99 + 1 ) )
      ai = t
    END IF
  NEXT t
  split in
  IF ai = 0 THEN
  'geen sleutel gevonden ?
  'no key fount ?
    IF mijn = "" THEN
    'geen vorig bezit ?
    'no item stored ?
      t = 1
      while word( t ) <> ""
        t = t + 1
      wend
      IF word( t - 1 ) = "my" THEN
      'bezit in zin ?
      'item in sentence ?
        mijn = word( t ) 'sla bezit op
      END IF
      color cyan , black
      SELECT CASE INT(RND * 4)
      'reageer als niets is gevonden
      'react when nothing fount
        CASE IS = 0
          PRINTtext "can you tel me more ?"
        CASE IS = 1
          PRINTtext "that is verry intresting ."
        CASE IS = 2
          PRINTtext "plaese eleborate on that ."
        CASE IS = 3
          PRINTtext "that is not seldom ."
      END SELECT
    ELSE
      'reageer op laatste bezit en vergeet bezit
      'react on last item and forget last item
        color gray , black
        PRINTtext "Before you told me about your " + mijn + " ."
        PRINTtext "Can you tel me more about your " + mijn + " ?"
        mijn = ""
      END IF
    else
      dim as string uit
      IF RIGHT( antwoord , 1 ) = "=" THEN
      'reactiezin heeft aanhangsel
      'reaction has mirror-part
      antwoord = LEFT( antwoord , LEN( antwoord ) - 1 )
      'verwijder sleutel van zin
      'remove key from sentence
      in = RIGHT( in , LEN( in ) - LEN( zin( ai , 0 ) ) )
      split in
      uit = antwoord
      'plak spiegel worden achter reactiezin
      'te gebruiken voor vertaler
      'paste mirror after reaction
      'can be used for translator
      t = 1
      while word( t ) <> ""
      'alle woorden uit zin
      'al words out sentence
        qq = 0
        FOR e = 0 TO maxwoord
          IF word( t ) = a( e ) THEN
          'is woord een spiegelwoord ?
          'is word a mirror-word ?
            uit += b( e ) + " "
            qq = 1
          END IF
        NEXT e
        IF qq = 0 THEN
          uit += word( t ) + " "
        end if
        t = t + 1
      wend
      printtext uit + "?"
      for t = 0 to 40
        word( t ) = ""
      next t
    ELSE
      PRINT antwoord + " ."
    END IF
  end if
wend
printtext "Bey Bey . "
printtext "[ press return to end Dr Eliza . ]"
sleep
END

'               mirror-data

'het is zeer warschijnlijk
'dat ik hier wat vergeten ben
'aub uitbreiden .

'it is posible that i forgot
'somthing here
'please expand

DATA "i" , "you" , "you" , "me" , "me", "you"
DATA "mine" , "your" , "your" , "mine" , "my" , "your"
DATA "am" , "are" , "are" , "am" , "m" , "are"

DATA "=","="

'                     sleutel en zinnen data
'                     key and reaction data

'dit is het interesantste gedeelte
'this is the most intresting part
'en voor uitbreidig en verbetering vatbaar
'and must be expand en inproved
'een sleutel bestaat uit een of meer woorden
'a key exist out one or two words
'en heeft 3 reactie zinnen .
'and has 3 reaction sentences .
'als je de reactie zin met = laat eindigen
'if you end the sentence with a =
'plakt het progamma het
'the program wil paste
'gespiegelde gedeelte erachter
'the mirrored part behind it
'dan moet de sleutel wel in t begin
'then the key must be at the beginining
'van de zin staan
'of the sentence

DATA "naturly"
DATA "Are you always so sure ?"
DATA "Do you know for sure ?"
DATA "You are verry sure ."

DATA "computers"
DATA "Do you meen me too ?"
DATA "Do you have that more with computers ?"
DATA "All computers ?"

DATA "i have"
DATA "Why you have ="
DATA "Howlong you have ="
DATA "Do you often have ="

DATA "i am"
DATA "Are you often ="
DATA "Why you are ="
DATA "Howlong you are ="

DATA "i wish that"
DATA "Does it make a difference if ="
DATA "Why you wish that ="
DATA "Wish you often that ="

DATA "i think that"
DATA "Do you doubt that ="
DATA "Think you often that ="
DATA "Why you think that ="

DATA "i want"
DATA "Why you want ="
DATA "Do you often want ="
DATA "Howlong do you want ="

DATA "i hate"
DATA "Do you often hate ="
DATA "Why you hate ="
DATA "When you hate ="

DATA "i love"
DATA "Do you muth love ="
DATA "Why you love ="
DATA "Do you often love ="

DATA "i like"
DATA "Do you muth like ="
DATA "Why you like ="
DATA "Do you often like ="

DATA "=","=","=","="



Code: Select all

'' bluatigro 13 sept 2018
'' big DOS module

#include "color.bas"
#include "_big_chars.bas"

dim shared as double qx
qx = winx / 84
dim shared as double qy
qy = winy / 29
dim shared as double qdx
qdx = qx / 8
dim shared as double qdy
qdy = qy / 8

dim as double x , y
dim shared as integer cursorx , cursory
cursory = 2
dim as string in

dim shared as ubyte p( 84 , 29 )

sub newscreen
  cls
  dim as double x , y
  for x = 0 to 84
    for y = 0 to 29
      text2 qx * x , qy * y , chr( p( x , y ) ) , qdx , qdy , white
    next y
  next x
end sub

sub newline
  dim as integer i , j
  for i = 2 to 82
    for j = 2 to 26
      p(i,j) = p(i,j+1)
    next j
  next i
end sub

sub printtext( txt as string )
  dim as integer i
  if len( txt ) > 80 then exit sub
  for i = 1 to len( txt )
    text2 qx*i,qy*cursory,mid(txt,i,1),qdx,qdy,white
    p( i + 1 , cursory ) = asc( mid( txt , i , 1 ) )
  next i
  cursory += 1
  if cursory > 27 then
    newline
    newscreen
  end if
end sub
 
function inputtext( txt as string ) as string
  dim as string in , uit
  printtext txt
  cursorx = 2
  while in <> chr( 13 )
    in = ""
    while in = ""
      in = inkey
      text2 qx*cursorx,qy*cursory,chr(2),qdx,qdy,white
      sleep 100
      text2 qx*cursorx,qy*cursory,chr(2),qdx,qdy,black
      sleep 100
    wend
    text2 qx*cursorx,qy*cursory,in,qdx,qdy,white
    p(cursorx,cursory)=asc(in)
    uit += in
    cursorx += 1
  wend
  cursory += 1
  if cursory > 27 then
    newline
    newscreen
  end if
  return uit
end function



bluatigro
Posts: 564
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: big DOS like game

Postby bluatigro » Sep 13, 2018 11:02

update :
backspace in inputtext() try

error :
the cursor reacts good on backspace
but the output not

Code: Select all

'' bluatigro 13 sept 2018
'' big DOS game

#include "color.bas"
#include "_big_chars.bas"

dim shared as double qx
qx = winx / 84
dim shared as double qy
qy = winy / 29
dim shared as double qdx
qdx = qx / 8
dim shared as double qdy
qdy = qy / 8

dim as double x , y
dim shared as integer cursorx , cursory
cursory = 2
dim as string in

dim shared as ubyte p( 84 , 29 )

sub newscreen
  cls
  dim as double x , y
  for x = 0 to 84
    for y = 0 to 29
      text2 qx * x , qy * y , chr( p( x , y ) ) , qdx , qdy , white
    next y
  next x
end sub

sub newline
  dim as integer i , j
  for i = 2 to 82
    for j = 2 to 26
      p(i,j) = p(i,j+1)
    next j
  next i
end sub

sub printtext( txt as string )
  dim as integer i
  if len( txt ) > 80 then exit sub
  for i = 1 to len( txt )
    text2 qx*i,qy*cursory,mid(txt,i,1),qdx,qdy,white
    p( i + 1 , cursory ) = asc( mid( txt , i , 1 ) )
  next i
  cursory += 1
  if cursory > 27 then
    newline
    newscreen
  end if
end sub
 
function inputtext( txt as string ) as string
  dim as string in , uit
  printtext txt
  cursorx = 2
  while in <> chr( 13 )
    in = ""
    while in = ""
      in = inkey
      text2 qx*cursorx,qy*cursory,chr(2),qdx,qdy,white
      sleep 100
      text2 qx*cursorx,qy*cursory,chr(2),qdx,qdy,black
      sleep 100
    wend
    if asc( in ) = 8 then
      if len( uit ) > 0 then
        uit = left( uit , len( uit ) - 1 )
      end if
      cursorx -= 2
    end if 
    text2 qx*cursorx,qy*cursory,in,qdx,qdy,white
    p(cursorx,cursory)=asc(in)
    uit += in
    cursorx += 1
  wend
  cursory += 1
  if cursory > 27 then
    newline
    newscreen
  end if
  return uit
end function

in = inputtext( "What is your name ?" )
printtext "Hello " + in + " ."
printtext ""
printtext "[ push return ]"
sleep

Return to “General”

Who is online

Users browsing this forum: No registered users and 6 guests