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
© Peter Nairn 2006