R.T.Russell Home Page

Appendix F - Character Designer Listing



     REM ***********************************
     REM * User defined character designer *
     REM * Version 1.0            2/1/2006 *
     REM * Peter Nairn                     *
     REM ***********************************

     REM Declare arrays and structure
     
DIM Grid%(8,8)
     DIM RowTotal%(8)
     DIM Cursor{Row%,Col%,LastRow%,LastCol%}

     PROC_Init
     PROC_DrawMainScreen
     PROC_DrawCharacter
     PROC_DrawCursor

     REPEAT
       
Action%=FN_GetUserAction
       PROC_ProcessAction(Action%)
     UNTIL Exit

     PROC_Shutdown

     END

     
REM ***************************************************
     REM PROC_Init - initial setup when program is started
     
DEF PROC_Init

     REM Setup graphics mode
     
MODE 21

     REM Setup user characters 240, 241 and 242
     
VDU 23,240,0,0,0,0,0,0,0,0
     VDU 23,241,255,129,129,129,129,129,129,255
     VDU 23,242,255,255,255,255,255,255,255,255

     REM Setup cursor location
     
Cursor.Row%=1
     Cursor.LastRow%=1
     Cursor.Col%=1
     Cursor.LastCol%=1

     REM Set Exit flag
     
Exit=FALSE

     
REM Turn text cursor off
     
VDU 23,1,0;0;0;0;

     ENDPROC

     
REM ***************************************************
     REM PROC_DrawMainScreen - prints static text,
     REM                       title, help etc.
     
DEF PROC_DrawMainScreen

     REM Set background colour
     
COLOUR 128+7
     CLS
     COLOUR
0

     REM Print title
     
PRINT TAB(15,0);"Character Designer"
     PRINT TAB(15,1);STRING$(19,"=")

     REM Print help instructions
     
PRINT TAB(1,3);"Instructions:"
     PRINT TAB(1,4);"Use arrow keys to move cursor."
     PRINT TAB(1,5);"Press space to toggle selected cell."
     PRINT TAB(1,6);"Press X or ESC to exit."

     ENDPROC

     
REM ***************************************************
     REM PROC_DrawCharacter - called when character changes
     REM                      to redisplay it
     
DEF PROC_DrawCharacter
     LOCAL ColValue%,Row%,Col%

     REM Draw grid and calculate totals for each row
     
FOR Row%=1 TO 8
       ColValue%=128
       RowTotal%(Row%)=0
       FOR Col%=1 TO 8
         IF Grid%(Col%,Row%)=0 THEN
           PRINT TAB(
18+Col%,10+Row%);CHR$(241)
         ELSE
           PRINT TAB(
18+Col%,10+Row%);CHR$(242)
           RowTotal%(Row%)=RowTotal%(Row%)+ColValue%
         ENDIF
         
ColValue%=ColValue%/2
       NEXT Col%

       PRINT TAB(28,10+Row%);"    "
       PRINT TAB(28,10+Row%);RowTotal%(Row%)
     NEXT Row%

     REM Draw actual character
     
VDU23,240,RowTotal%(1),RowTotal%(2),RowTotal%(3), \
     \         RowTotal%(4),RowTotal%(5),RowTotal%(6), \
     \         RowTotal%(7),RowTotal%(8)
     FOR Col%=1 TO 8
       PRINT TAB(18+Col%,20);CHR$(240)
     NEXT Col%

     REM Print VDU codes
     
PRINT TAB(7,22);"BASIC code to produce this character: "
     PRINT TAB(1,24);STRING$(50," ")
     PRINT TAB(4,24);"VDU 23,240";
     FOR Row%=1 TO 8
       PRINT ",";STR$(RowTotal%(Row%));
     NEXT Row%

     ENDPROC

     
REM ***************************************************
     REM PROC_DrawCursor - delete cursor from old position
     REM                   and redraw in new
     
DEF PROC_DrawCursor

     REM Set to normal colour and erase old cursor
     
COLOUR 0
     PRINT TAB(18+Cursor.LastCol%,10+Cursor.LastRow%);
     IF Grid%(Cursor.LastCol%,Cursor.LastRow%)=0 THEN
       PRINT CHR$
(241)
     ELSE
       PRINT CHR$
(242)
     ENDIF
     
REM Set to highlight colour and draw cursor
     
COLOUR 1
     PRINT TAB(18+Cursor.Col%,10+Cursor.Row%);
     IF Grid%(Cursor.Col%,Cursor.Row%)=0 THEN
       PRINT CHR$
(241)
     ELSE
       PRINT CHR$
(242)
     ENDIF
     
REM Set back to normal colour
     
COLOUR 0

     ENDPROC

     
REM ***************************************************
     REM FN_GetUserAction - returns a valid action code
     REM                    when selected by user
     
DEF FN_GetUserAction
     LOCAL Key%,Code%

     REPEAT
       
REM Wait for keypress
       
Key%=GET
       
REM Translate key press to action code
       
CASE Key% OF
         WHEN
139: Code%=1   :REM Up
         
WHEN 137: Code%=2   :REM Right
         
WHEN 138: Code%=3   :REM Down
         
WHEN 136: Code%=4   :REM Left
         
WHEN 32: Code%=5    :REM Toggle - space
         
WHEN 88: Code%=999  :REM Exit
         
WHEN 120: Code%=999
         OTHERWISE Code%=0
       ENDCASE
     UNTIL
Code%<>0

     =Code%

     REM ***************************************************
     REM PROC_ProcessAction - actions a valid code
     
DEF PROC_ProcessAction(Code%)

     CASE Code% OF
       WHEN
1: PROC_MoveCursor(1)
       WHEN 2: PROC_MoveCursor(2)
       WHEN 3: PROC_MoveCursor(3)
       WHEN 4: PROC_MoveCursor(4)
       WHEN 5:
         IF Grid%(Cursor.Col%,Cursor.Row%)=1 THEN
           
Grid%(Cursor.Col%,Cursor.Row%)=0
         ELSE
           
Grid%(Cursor.Col%,Cursor.Row%)=1
         ENDIF
         PROC
_DrawCharacter
       WHEN 999:
         REM Set exit flag
         
Exit=TRUE
     ENDCASE

     PROC
_DrawCursor

     ENDPROC

     
REM ***************************************************
     REM PROC_MoveCursor - move cursor in direction given:
     REM                   1-Up, 2-Right, 3-Down, 4-Left
     
DEF PROC_MoveCursor(Dirn%)

     REM Save current position in old position
     
Cursor.LastRow%=Cursor.Row%
     Cursor.LastCol%=Cursor.Col%

     REM Check limits and move
     
CASE Dirn% OF
       WHEN
1: IF Cursor.Row%>1 Cursor.Row% -=1
       WHEN 2: IF Cursor.Col%<8 Cursor.Col% +=1
       WHEN 3: IF Cursor.Row%<8 Cursor.Row% +=1
       WHEN 4: IF Cursor.Col%>1 Cursor.Col% -=1
     ENDCASE

     ENDPROC

     
REM ***************************************************
     REM PROC_Shutdown - tidies up before exiting
     
DEF PROC_Shutdown

     REM Re-enable text cursor
     
VDU 23,1,1;0;0;0;
     REM Set cursor to bottom of screen
     
PRINT TAB(0,26);

     ENDPROC




Best viewed with Any Browser Valid HTML 3.2!
© Peter Nairn 2006