'-------------------------------------------------------------
' Tutorial "Programmieren für Oma"
' www.askos.de/tutorial

' Example 341: Block Graphics Mini Painting
' by C. Schatz, 2005

' This program has errors. One was implemented deliberately...
'-------------------------------------------------------------


OPTION EXPLICIT

TYPE tcursor
  x AS INTEGER
  y AS INTEGER
  xold AS INTEGER
  yold AS INTEGER
  colhid AS INTEGER
  symbhid AS INTEGER
  colhid2 AS INTEGER
  symbhid2 AS INTEGER  
  col AS INTEGER
  symb AS INTEGER
END TYPE

COMMON SHARED cursor AS tcursor
COMMON SHARED screenwidth AS INTEGER
COMMON SHARED screenheight AS INTEGER
COMMON SHARED cursorcolor AS INTEGER
COMMON SHARED bgcol AS INTEGER
COMMON SHARED drawcol AS INTEGER
COMMON SHARED pencilcol AS INTEGER
CONST blinktime=400
CONST Isavebg=1
CONST Inone=0
CONST drawchar=219
CONST Inocolor=16

cursor.x=1

screenwidth=80
screenheight=25
cursorcolor=10

'------------------------------------------
SUB showinfos
    'Current drawing color
    LOCATE screenheight,screenwidth-1
    COLOR drawcol
    PRINT CHR$(drawchar);
    'Misc infos
    LOCATE screenheight,1
    COLOR 15
    PRINT "Quit: Esc";
END SUB

'------------------------------------------
SUB init

  DIM col1
  
  cursor.x=screenwidth/2
  cursor.y=screenheight/2
  cursor.xold=cursor.x
  cursor.yold=cursor.y
  cursor.col=cursorcolor
  cursor.symb=ASC("K")
  
  col1=COLOR
  bgcol=HIWORD(col1)
  drawcol=Inocolor
  pencilcol=15
  
  showinfos  
  
END SUB



'------------------------------------------
SUB unplotcursor
  
  LOCATE cursor.y,cursor.x
  COLOR cursor.colhid
  PRINT CHR$(cursor.symbhid);
END SUB


'------------------------------------------
SUB plotcursor(savebg AS INTEGER)
  
  DIM xnew AS INTEGER, ynew AS INTEGER
  
  IF (savebg=Isavebg) THEN
    'First unplot the cursor at the old position
    xnew=cursor.x:ynew=cursor.y
    cursor.x=cursor.xold:cursor.y=cursor.yold
    unplotcursor
    'Then save the backround at the new position
    cursor.x=xnew:cursor.y=ynew
    cursor.symbhid=SCREEN(cursor.y,cursor.x,0)    
    cursor.colhid=SCREEN(cursor.y,cursor.x,1)
  END IF
  LOCATE cursor.y,cursor.x
  COLOR cursor.col
  PRINT CHR$(cursor.symb);
  'Pencil activated?
  IF (drawcol<Inocolor) then 
    cursor.symbhid2=cursor.symbhid
    cursor.colhid2=cursor.colhid
    cursor.symbhid=drawchar
    cursor.colhid=drawcol
  END IF    
  
END SUB


'------------------------------------------
FUNCTION cursorblink AS STRING

  'Waits for a key stroke, makes the cursor blink and returns
  'the key (e.g. CHR$(0)+"M" for "Cursor rightside")
  
  DIM i AS INTEGER, j AS INTEGER
  DIM s AS STRING*100
  DIM cursorstate AS INTEGER
  
  'Clear the keyboard buffer
  FOR i=0 TO 99:s=INKEY$:NEXT i
  
  plotcursor(Isavebg)
  cursorstate=1
  
  'Wait for key
  DO WHILE (1=1)        
    SLEEP blinktime
    s=inkey$
    IF (s<>"") THEN EXIT DO
    cursorstate=1-cursorstate
    IF (cursorstate=1) THEN plotcursor(Inone)
    IF (cursorstate=0) THEN unplotcursor
  LOOP
  
  cursorblink=s
    
END FUNCTION

'------------------------------------------
SUB cursorleft
  cursor.x=cursor.x-1
  IF (cursor.x<1) THEN cursor.x=1
END SUB
  
'------------------------------------------
SUB cursorright
  cursor.x=cursor.x+1
  IF (cursor.x>screenwidth-1) THEN cursor.x=screenwidth-1
END SUB

'------------------------------------------
SUB cursorup
  cursor.y=cursor.y-1
  IF (cursor.y<1) THEN cursor.y=1
END SUB

'------------------------------------------
SUB cursordown
  cursor.y=cursor.y+1
  IF (cursor.y>screenheight) THEN cursor.y=screenheight
END SUB

'------------------------------------------
SUB switchpencilstatus
  
  IF (drawcol=Inocolor) then 
    drawcol=pencilcol 
  else 
    drawcol=Inocolor
    cursor.symbhid=cursor.symbhid2
    cursor.colhid=cursor.colhid2
  END IF
  
END SUB

'------------------------------------------
SUB togglecolup
  
  pencilcol=pencilcol+1
  IF (pencilcol=Inocolor) THEN pencilcol=0
  IF (drawcol<Inocolor) THEN drawcol=pencilcol
END SUB

'------------------------------------------
SUB main
  
  DIM s AS STRING

  CLS
  init
  WHILE (1=1)
    'Wait for next key and blink cursor
    s=cursorblink
    'Show drawing color in right lower corner
    showinfos
    
    'key control
    IF (LEFT$(s,1)=CHR$(255)) THEN
        '? "Hello!</b>":sleep
        IF (RIGHT$(s,1)=CHR$(75)) THEN cursorleft
        IF (RIGHT$(s,1)=CHR$(77)) THEN cursorright
        IF (RIGHT$(s,1)=CHR$(72)) THEN cursorup
        IF (RIGHT$(s,1)=CHR$(80)) THEN cursordown
        IF (RIGHT$(s,1)=CHR$(73)) THEN togglecolup
    END IF
    IF (s=" ") THEN  switchpencilstatus
    IF (s=CHR$(27)) THEN EXIT SUB

  WEND
  
END SUB

'------------------------------------------

main