Silly Programming Ideas - Turning Text into Graphics

[AMSDOS]

Updated: version of Block Editor so now it's possible to Load a Save Contents and have altered Cursor so Arrow Keys now control it (instead of Q,A,O,P combination) & instead of using Space Bar to draw pixel, Keys 0-9 & A-E can be used to draw corresponding Pen Colours (A-E use PEN colours 10-14). I haven't implemented user defined INK colours yet and include some sort of export tool.

[AMSDOS]

Current version of the Block Editor now has provision to edit inks and the program will save those Inks & display them again when the "filename.blk" is loaded. Consequently this has resulted in a change of the file format which the earlier version of the Block Editor won't support.

Initially I was thinking of incorporating various ways of Saving these screens into this program, though I'm thinking of writing a Converter program to handle this which could in turn transform it into one of my Assembly Drawing routines.


I've tried to make this program easy to use from the Keyboard with:


Arrow Keys  - Move Cursor around the screen
Space Bar - Place Block (Default Pen 1)
L - Load File (at the prompt, and no I haven't included a Catalogued Directory)
S - Save File (asks for filename)
I - Takes you to the Ink Palette menu with further Options.
Left, Right Arrows - Place the cursor under the Colour, I ditched the idea of using 0-9 & A-E to select each Coloured Block because my program was lagging form a massive Keypress routine, so this can be used to select the appropriate colour
Up, Down Arrow - In conjunction with the Left, Right Arrows to select from above, this can be used to select INK number & Colour.
Enter / Return - Exit from Ink Palette & back to main Editor


Enter / Return - from the main editor this will exit the program, so take care not to use this without saving your image because the Image will be wiped when this program is executed and returned to the default Palette.

Code: [Select]

10 ' Block Editor
20 '
30 GOSUB 110
40 WHILE INKEY(18)=-1
50 GOSUB 310
60 GOSUB 410
70 WEND:MODE 2:PEN 1:CALL &BC02:END
100 ' Initialise Variables
110 MODE 0
120 GOSUB 1210
130 DIM grid%(25,20)
140 x%=10:y%=10
150 oldx%=x%:oldy%=y%
160 c%=1
170 RESTORE 230
180 FOR p%=0 TO 14
190  READ cl%
200  grid%(0,p%)=cl%
210  INK p%,grid%(0,p%)
220 NEXT p%
230 DATA 1,24,20,6,26,0,2,8,10,12,14,16,18,22,9
240 RETURN
300 ' Print Cursor
310 PRINT CHR$(22)+CHR$(1);
320 LOCATE x%,y%
330 PEN 15
340 PRINT"X";
350 oldx%=x%:oldy%=y%
360 RETURN
400 ' Check for Keypress
410 WHILE ch$=""
420 ch$=UPPER$(INKEY$)
430 IF ch$=CHR$(240) AND (y%<>1) THEN y%=y%-1 : pr%=1
440 IF ch$=CHR$(241) AND (y%<>25) THEN y%=y%+1 : pr%=1
450 IF ch$=CHR$(242) AND (x%<>1) THEN x%=x%-1 : pr%=1
460 IF ch$=CHR$(243) AND (x%<>20) THEN x%=x%+1 : pr%=1
470 IF pr%=1 THEN pr%=0 : GOSUB 610
480 IF ch$=" " THEN GOSUB 710
490 IF ch$="I" THEN sx%=x% : sy%=y% : GOSUB 1310
500 IF ch$="S" THEN sx%=x% : sy%=y% : GOSUB 810 : MODE 0 : GOSUB 1110
510 IF ch$="L" THEN sx%=x% : sy%=y% : GOSUB 910 : MODE 0 : GOSUB 1110
520 WEND
530 ch$=""
540 RETURN
600 ' Preserve Block
610 PEN grid%(oldy%,oldx%)
620 PRINT CHR$(22)+CHR$(0);
630 LOCATE oldx%,oldy%
640 PRINT CHR$(143);
650 PRINT CHR$(22)+CHR$(1);
660 RETURN
700 ' Print Block
710 LOCATE x%,y%
720 grid%(y%,x%)=c%
730 PEN grid%(y%,x%)
740 PRINT CHR$(143);
750 RETURN
800 ' Save File
810 MODE 1:PEN 1
820 INPUT"Enter Filename:";fl$
830 OPENOUT "!"+fl$
840  FOR y%=0 TO 25
850  FOR x%=0 TO 20
860   PRINT#9,grid%(y%,x%);
870  NEXT x% : PRINT#9
880  NEXT y%
890 CLOSEOUT:RETURN
900 ' Load File & Inks
910 MODE 1:PEN 1
920 INPUT"Enter Filename:";fl$
930 OPENIN "!"+fl$
940  FOR y%=0 TO 25
950  FOR x%=0 TO 20
960   INPUT#9,grid%(y%,x%)
970  NEXT x%
980  NEXT y%
990 CLOSEIN
1000 FOR i%=0 TO 14
1010  INK i%,grid%(0,i%)
1020 NEXT i%
1030 RETURN
1100 ' Draw in Screen & Window Setup
1110 y%=1
1120 WHILE y%<=25
1130 FOR x%=1 TO 20
1140  LOCATE x%,y%
1150  PEN grid%(y%,x%)
1160  PRINT CHR$(143);
1170 NEXT x%
1180 y%=y%+1
1190 WEND
1200 x%=sx% : y%=sy%
1210 WINDOW 1,20,1,25
1220 WINDOW#1,1,20,24,25
1230 RETURN
1300 ' Select Pen and or Change Inks
1310 CLS#1
1320 xp%=1
1330 FOR p%=0 TO 14
1340  PEN#1,p%
1350  LOCATE#1,xp%,1
1360  PRINT#1,CHR$(143);
1370  xp%=xp%+1
1380 NEXT p%
1390 p%=c% : xp%=p%+1
1400 WHILE INKEY(18)=-1
1410  LOCATE#1,xp%,2
1420  PEN#1,15
1430  PRINT#1,CHR$(244);
1440  ich$=UPPER$(INKEY$)
1450  IF ich$=CHR$(243) AND xp%<15 THEN oxp%=xp%:xp%=xp%+1: p%=xp%-1 : c%=p% : GOSUB 1610
1460  IF ich$=CHR$(242) AND xp%>1 THEN oxp%=xp%:xp%=xp%-1: p%=xp%-1 : c%=p% : GOSUB 1610
1470  IF ich$=CHR$(240) AND grid%(0,p%)<26 THEN grid%(0,p%)=grid%(0,p%)+1 : INK p%,grid%(0,p%)
1480  IF ich$=CHR$(241) AND grid%(0,p%)>0 THEN grid%(0,p%)=grid%(0,p%)-1 : INK p%,grid%(0,p%)
1490 WEND
1500 CLS#1
1510 y%=24
1520 GOSUB 1120
1530 RETURN
1600 ' Cursor Update
1610 LOCATE#1,1,1:PRINT#1,CHR$(22)+CHR$(0);
1620 LOCATE#1,oxp%,2
1630 PRINT#1," ";
1640 LOCATE#1,1,1:PRINT#1,CHR$(22)+CHR$(1);
1650 RETURN

[AMSDOS]

I've put together a program in BASIC which demonstrates the use of Condensed Text.


I'm working on a program which uses all 3 Screen Modes and needed something to support that, in this programs case, I've setup a variable (mo%) which can equal 1,2 or 4 when using Mode 2,1 or 0.


[attachimg=3]


And the resulting program looks like this:


[attachimg=2]

[AMSDOS]

Hi folks,


Unfortunately I made a slight blunder in the Condensed Text program above, which has resulted in me making this correction, the blunder only becomes apparent when x% starts to become any value other than 0.


The following line needs to be amended to this:

Code: [Select]

3110  MOVE x%+(mo%*w%),y%


So now x% can be used to correctly position the text across the screen.

[AMSDOS]

Earlier in this topic I made a command-line Graphics prompt program, which I've now extended into Moving Pixel (Plot Mode), along with Lines & even I've also added the Bresenham Circle Routine.

The program has a number of options:-

Press:-
'M' to change the screen Mode (initially Mode 2)

'P' enter Plot Mode, while in Plot Mode (TAB to Exit), Cursor Keys to Move Pixel, CTRL to change the Graphics Pen, SPACE to Draw a Point in that Colour, though Graphics are XORed so colour may change, the Space Key can be used remove the point and it's a little bit odd, the dot will disappear when a Pixel has been plotted.

'D' enter Draw Mode (TAB to Exit), Up/Down to Increase/Decrease Y Coordinate, Left/Right Decrease/Increase X Coordinate, Space Draws the Line.

'C' enter Circle Mode (Tab to Exit), Up/Down to Increase/Decrease Radius, Space to Draw.

Program is still a WIP, so maybe I can improve it.

Code: [Select]

10 ' BASIC Graphics
20 ' Updated - 20.12.2015
30 INK 0,0:INK 1,26:BORDER 1: mo%=2: MODE mo%: GOSUB 1710
31 GOSUB 1510 : CALL &100 : GOSUB 1610
40 c%=1:exit=0
50 WHILE exit=0
70 IF INKEY(61)<>-1 THEN WHILE INKEY$<>"":WEND:PRINT CHR$(23);CHR$(0):CLS#1:LOCATE#1,1,1:PRINT#1,"Draw";:GOSUB 210
71 IF INKEY(62)<>-1 THEN WHILE INKEY$<>"":WEND:PRINT CHR$(23);CHR$(0):CLS#1:LOCATE#1,1,1:PRINT#1,"Circle": GOSUB 410 : CLS#1
72 IF INKEY(38)<>-1 THEN mo%=mo%+1 : GOSUB 1810
80 IF INKEY(58)<>-1 THEN exit=1
90 IF INKEY(27)<>-1 THEN WHILE INKEY$<>"":WEND:PRINT CHR$(23);CHR$(1):CLS#1:LOCATE#1,1,1:PRINT#1,"Plot":GOSUB 1020
100 WEND : WHILE INKEY$<>"" : WEND : MODE 2 : CALL &BC02 : END
200 ' Draw Subroutine
210 WHILE INKEY(68)=-1
220  LOCATE#1,6,1
230  PRINT#1,x%;
240  LOCATE#1,11,1
250  PRINT#1,"x";
260  LOCATE#1,12,1
270  PRINT#1,y%;
280  IF INKEY(8)<>-1 AND x%>0 THEN x%=x%-jp%
290  IF INKEY(1)<>-1 AND x%<638 THEN x%=x%+jp%
300  IF INKEY(0)<>-1 AND y%<398 THEN y%=y%+2
310  IF INKEY(2)<>-1 AND y%>16 THEN y%=y%-2
311  IF INKEY(47)<>-1 THEN DRAW x%,y%,c%
320 WEND
340 CLS#1
350 RETURN
400 ' Circle Subroutine
410 WHILE INKEY(68)=-1
420  LOCATE#1,8,1
430  PRINT#1,"Radius";
440  LOCATE#1,15,1
450  PRINT#1,r%;
460  IF INKEY(0)<>-1 AND r%<100 THEN r%=r%+1
470  IF INKEY(2)<>-1 AND r%>0 THEN r%=r%-1
480  IF INKEY(47)<>-1 THEN GOSUB 1310
490 WEND
500 RETURN
600 ' Change Colour
610 IF PEEK(&107)=0 AND c%=16 THEN c%=0
611 IF PEEK(&107)=1 AND c%=4 THEN c%=0
612 IF PEEK(&107)=2 AND c%=2 THEN c%=0
613 PRINT CHR$(23);CHR$(0);
614 PLOT x%,y%,c%
615 PRINT CHR$(23);CHR$(1);
620 RETURN
1000 ' Plot Subroutine
1020 PLOT x%,y%,c%
1030 WHILE INKEY(68)=-1
1040  IF INKEY(8)<>-1 AND x%>0 THEN oldx%=x%:GOSUB 1210:x%=x%-jp%:GOSUB 1230
1050  IF INKEY(1)<>-1 AND x%<638 THEN oldx%=x%:GOSUB 1210:x%=x%+jp%:GOSUB 1230
1060  IF INKEY(0)<>-1 AND y%<398 THEN oldy%=y%:GOSUB 1220:y%=y%+2:GOSUB 1230
1070  IF INKEY(2)<>-1 AND y%>16 THEN oldy%=y%:GOSUB 1220:y%=y%-2:GOSUB 1230
1071  IF INKEY(23)<>-1 THEN c%=c%+1:GOSUB 610:WHILE INKEY$<>"":WEND
1072  IF INKEY(47)<>-1 THEN GOSUB 1230:WHILE INKEY$<>"":WEND
1080  LOCATE#1,6,1:PRINT#1,x%;"x";y%;
1090 WEND
1091 CLS#1: GOSUB 1230
1100 WHILE INKEY$<>"":WEND
1110 RETURN
1200 ' Remove old point
1210 PLOT oldx%,y%,c%:RETURN
1220 PLOT x%,oldy%,c%:RETURN
1230 PLOT x%,y%,c%:RETURN
1300 ' Plot Circle
1310 cx%=x% : cy%=y%
1320 xp%=r% : yp%=0 : decision%=1-xp%
1330 ORIGIN cx%,cy%
1340 WHILE xp%>=yp%
1350  GOSUB 1410
1360  yp%=yp%+stp%
1370  IF decision%<0 THEN decision%=decision%+2*yp%+1 ELSE xp%=xp%-stp%:decision%=decision%+2*(yp%-xp%+1)
1380 WEND
1381 ORIGIN 0,0
1390 RETURN
1400 ' Routine to Plot Circle
1410 PLOT -yp%,xp%,c% : PLOT yp%,xp%,c%
1420 PLOT -xp%,yp%,c% : PLOT xp%,yp%,c%
1430 PLOT -xp%,-yp%,c% : PLOT xp%,-yp%,c%
1440 PLOT -yp%,-xp%,c% : PLOT yp%,-xp%,c%
1450 RETURN
1500 ' Detect which mode is being used
1510 FOR addr%=&100 TO &107
1520  READ a$
1530  POKE addr%,VAL("&"+a$)
1540 NEXT addr%
1550 RETURN
1560 DATA cd,11,bc,32,07,01,c9,00
1600 ' Assign Appropriate Value depending on Mode
1610 IF PEEK(&107)=0 THEN stp%=2:jp%=4:x%=320:y%=200
1620 IF PEEK(&107)=1 THEN stp%=2:jp%=2:x%=320:y%=200
1630 IF PEEK(&107)=2 THEN stp%=1:jp%=1:x%=320:y%=200
1640 RETURN
1700 ' Setup Window
1710 WINDOW#1,1,20,25,25
1720 RETURN
1800 ' Change Mode
1810 IF mo%=3 THEN mo%=0
1820 MODE mo%
1830 GOSUB 1710
1840 LOCATE#1,1,1
1850 PRINT#1,"Mode";mo%
1855 CALL &100
1860 GOSUB 1610
1870 RETURN

Haven't put a save feature in it yet cause I'm working that part of the program in with the Menu System, but I got some screenshots.


[attachimg=1]


[attachimg=2]


[attachimg=3]


[attachimg=4]


[attachimg=5]

[AMSDOS]

I've made some changes to the Condensed Text Demo to allow for some Multicoloured Characters, the example I made (which I forgot to dump), adds a data statement at the end of the program which holds the Graphical Pen numbers, the Longest Line has 32 characters in it, so the data needs to be that length, a restore is added at the start of the routine to Display the text and a Read b$ to read the colour data & plot to set the graphics pen for the text.  Result looks good.


[attachimg=1]


Program attached below:

[AMSDOS]

 


Earlier on I found this interesting early program from Home Computing Weekly to Redesign the Character Set:





It lets you redefine the character set between 124-255, but it's useful because you can see what your defining as you go from character to character, though you have to be sure to start defining each character with 'N' for New Character, to which is asks which character your defining and once you've defined that character press Enter/Return to Store it in that position.  Plus it has lots of options as the screenshot shows, though Loading & Saving saves the Character Set to a Binary File, which is where my program comes in.


With my program it takes a Character Definitions from the Binary File, and converts it to BASIC ASCII file, so it asks for the 1st Redefined Character in the set, followed by the last Redefined Character, covering any characters in-between that range. I've given the user the opportunity to move the character set if they want, so for example my condensed character set which was redefined on characters 230 to 255, I can simply move it to character 65, the program works out the length of the set, so if you're using a character below 32, the program will pull you up on it, likewise if the Length of the Set is exceeding 255, it will let you know and tell you how low you can go with that set. When all that's done it asks for the filename with the redefined characters in it, followed by the name of the name of the ASCII BASIC, the program does the rest.

[AMSDOS]

I've put together this program for inputting a filename using condensed text. Up & Down Arrows to select the letter, Right Arrow to Select the Next Position & Left Arrow to Select the Previous Position. The program works, though if you use the Left Arrow to Edit the Previous Character, the Character to the right gets deleted, this is the filling effect from the print using a full width character, which unfortunately deletes the character to the right. I've tried variations of this, but this seems to be the best result I can get.

Code: [Select]


10 ' Select Filename Demo using Condensed Characters
20 '
30 MODE 0:SYMBOL AFTER 64
40 DIM file$(8):GOSUB 1010
50 a$="FILE:":x%=0 : y%=398 : mo% = 4 : GOSUB 2090
60 x% = 80 : y% = 398 : mo% = 4
70 spot%=1
80 a=65 : a$=CHR$(a)
90 GOSUB 2090
100 WHILE INKEY(18)=-1
110  IF INKEY(0)<>-1 AND a<90 THEN a=a+1 : a$=CHR$(a) : file$(spot%)=a$ : GOSUB 2090
120  IF INKEY(2)<>-1 AND a>65 THEN a=a-1 : a$=CHR$(a) : file$(spot%)=a$ : GOSUB 2090
130  IF INKEY(1)<>-1 AND spot%<8 THEN spot%=spot% + 1 : file$(spot%)=a$ : a=ASC(file$(spot%)) : x% = x% + 16 : GOSUB 2090
140  IF INKEY(8)<>-1 AND spot%>1 THEN spot%=spot% - 1 : file$(spot%)=a$ : a=ASC(file$(spot%)) : x% = x% - 16
150 FOR d%=1 TO 100:NEXT d%
160 WEND
170 WHILE INKEY$<>"":WEND
180 SYMBOL AFTER 256:MODE 2:END
1000 ' Condensed Characters (4 x 8)
1010 FOR num%= 65 TO 90
1020  FOR c%=1 TO 8:READ c(c%):NEXT c%
1030  SYMBOL num%,c(1),c(2),c(3),c(4),c(5),c(6),c(7),c(8)
1040 NEXT num%
1050 RETURN
1060 DATA 32, 80, 80, 112, 80, 80, 80, 0
1070 DATA 96, 80, 80, 96, 80, 80, 96, 0
1080 DATA 32, 80, 64, 64, 64, 80, 32, 0
1090 DATA 96, 80, 80, 80, 80, 80, 96, 0
1100 DATA 112, 64, 64, 96, 64, 64, 112, 0
1110 DATA 112, 64, 64, 96, 64, 64, 64, 0
1120 DATA 32, 80, 64, 112, 80, 80, 32, 0
1130 DATA 80, 80, 80, 112, 80, 80, 80, 0
1140 DATA 112, 32, 32, 32, 32, 32, 112, 0
1150 DATA 16, 16, 16, 16, 16, 80, 32, 0
1160 DATA 80, 80, 96, 96, 80, 80, 80, 0
1170 DATA 64, 64, 64, 64, 64, 64, 112, 0
1180 DATA 80, 112, 112, 80, 80, 80, 80, 0
1190 DATA 16, 80, 112, 112, 112, 80, 80, 0
1200 DATA 112, 80, 80, 80, 80, 80, 112, 0
1210 DATA 96, 80, 80, 96, 64, 64, 64, 0
1220 DATA 32, 80, 80, 80, 80, 80, 32, 16
1230 DATA 96, 80, 80, 96, 80, 80, 80, 0
1240 DATA 32, 80, 64, 32, 16, 80, 32, 0
1250 DATA 112, 32, 32, 32, 32, 32, 32, 0
1260 DATA 80, 80, 80, 80, 80, 80, 112, 0
1270 DATA 80, 80, 80, 80, 80, 32, 32, 0
1280 DATA 80, 80, 80, 80, 112, 112, 80, 0
1290 DATA 80, 80, 112, 32, 112, 80, 80, 0
1300 DATA 80, 80, 80, 32, 32, 32, 32, 0
1310 DATA 112, 16, 32, 32, 32, 64, 112, 0
2000 ' Display Text
2010 ' Entry Conditions:-
2020 '   x% = X coordinate
2030 '   y% = Y coordinate
2040 '   mo% = value relating to screen mode, appropriate values are
2050 '         1 for mode 2, 2 for mode 1 & 4 for mode 0
2060 '   a$ = character string to display, for this program char set 65 to 90
2070 '        are used to appropriately display capitals "A" to "Z"
2080 '
2090 FOR p%=1 TO LEN(a$)
2100  TAG
2110  MOVE x%+(mo%*w%),y%
2120  PRINT MID$(a$,p%,1);
2130  w%=w%+4
2140  TAGOFF
2150 NEXT p%
2160 w%=0
2170 RETURN


[AMSDOS]

For those interested, I've made some updates to the previous program, so now you use the Up/Down Key to select the Letter you want, but now you have to press Space to go to the next letter, if you made a mistake & need to go back, press Del and it will Delete the Current Letter and go back to the previous one for editing.


Here's the modifications:

Code: [Select]


130  IF INKEY(47)<>-1 AND spot%<8 THEN file$(spot%)=a$ : spot%=spot% + 1 : file$(spot%)=a$ : a=ASC(file$(spot%)) : x% = x% + 16 : GOSUB 2090
140  IF INKEY(79)<>-1 AND spot%>1 THEN a$=" " : file$(spot%)=a$ : GOSUB 2090 : spot% = spot% - 1 : a$ = file$(spot%) : a = ASC(file$(spot%)) : x% = x% - 16
171 a$="":FOR l%=1 TO 8:a$=a$+file$(l%):NEXT l%

For the last line (171), it simply takes the letters from the Array and stores them in a$, so when the program exits (with Enter or Return), a$ will contain the word.

[AMSDOS]

This particular program mightn't have much practical application for others here, but it's a funny & fun way of filling the Screen up using SCR FILL BOX. Earlier I was using SCR HW ROLL to have Bub pop up from the bottom of the screen, but this time I'm using Rolling the Graphics from Right of Screen.
I found a small routine which uses "SCR GET LOCATION" followed by a "SCR SET OFFSET" (after some INCs) which causes Roll, the Catch is whole scroll Rolls, forcing anything from the left side to appear on the Right, my demo program uses this scroll first to avoid issues.
The 2nd image I've got I'm using SCR SW ROLL, this does allow me to Roll a specific region of the screen without affecting what else is on it (provided it doesn't overlap), which has allowed me to come up with this funny effect.


The program will have more practical application if the area as used by SCR SW ROLL was adjustable, which will just require a slight adjustment to the M/C Data. For the SCR SW ROLL, H & D holds the Left & Right Columns, L & E holds the Top and Bottom Lines.

Code: [Select]


10 IF PEEK(&4000)<>221 THEN GOSUB 2010
20 MODE 0:GOSUB 5010
30 DIM col%(323),house%(180):GOSUB 1000:GOSUB 4010:a%=1:y%=0
40 WHILE (x%<>19)
50   FOR y%=0 TO 16
60     CALL &4000,col%(a%),19,y%
70     a%=a%+1
80   NEXT y%:CALL &4026:x%=x%+1:WEND
90 a%=1 : y%=0
100 WHILE (y%<>9)
110   FOR x%=0 TO 19
120     CALL &4000,house%(a%),x%,24
130     a%=a%+1
140   NEXT x% : CALL &4016 : y%=y%+1 : WEND
150 CALL &BB18:PEN 1:MODE 2:END
1000 ' Set up Colours
1010 RESTORE 3010:FOR a%=1 TO 323
1020 READ c%
1030 col%(a%)=c%
1040 NEXT a%:RETURN
2000 ' Poke M/C
2010 RESTORE 2050:FOR addr%=&4000 TO &4031
2020 READ a$
2030 POKE addr%,VAL("&"+a$)
2040 NEXT addr%:RETURN
2050 DATA DD,7E,04,CD,2C,BC
2060 DATA F5,DD,7E,02,67,57
2070 DATA DD,7E,00,6F,5F,F1
2080 DATA CD,44,BC,C9,06,01
2090 DATA 3E,00,26,00,16,19
2100 DATA 2E,0E,1E,18,CD,50
2110 DATA BC,C9,C0,CD,0B,BC
2120 DATA 23,23,23,23,CD,05
2130 DATA BC,C9
3000 ' 1st Block of Data for Horizontal Scroll
3010 DATA 10,10,10,7,7,7,0,3,3,3,4,4,4,0,0,0,0
3020 DATA 0,0,0,0,0,7,0,0,0,0,0,0,4,0,0,0,0
3030 DATA 0,0,0,0,0,7,0,0,0,0,0,0,4,0,0,0,0
3040 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
3050 DATA 0,0,0,0,7,7,0,0,0,0,0,4,4,0,0,0,0
3060 DATA 0,0,10,7,0,0,0,0,0,3,4,0,0,0,0,0,0
3070 DATA 10,10,0,7,0,0,0,3,3,0,4,0,0,0,0,0,0
3080 DATA 0,0,10,7,0,0,0,0,0,3,4,0,0,0,0,0,0
3090 DATA 0,0,0,0,7,7,0,0,0,0,0,4,4,0,0,0,0
3100 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
3110 DATA 10,10,10,7,7,7,0,3,3,3,4,4,4,0,0,0,0
3120 DATA 0,0,10,0,0,0,0,0,0,0,0,0,4,0,0,0,0
3130 DATA 0,0,0,7,0,0,0,0,0,0,0,0,4,0,0,0,0
3140 DATA 10,10,10,0,7,7,0,0,0,0,0,0,0,0,0,0,0
3150 DATA 0,0,0,0,0,0,0,0,0,0,0,4,4,0,0,0,0
3160 DATA 0,10,10,7,7,0,0,0,0,3,4,0,0,0,0,0,0
3170 DATA 10,0,0,0,0,7,0,3,3,0,4,0,0,0,0,0,0
3180 DATA 10,0,0,0,0,7,0,0,0,3,4,0,0,0,0,0,0
3190 DATA 10,10,10,7,7,7,0,0,0,0,0,4,4,0,0,0,0
4000 ' 2nd Block of Data for Vertical Scroll
4010 RESTORE 4060
4020 FOR a%=1 TO 180
4030   READ c%
4040   house%(a%)=c%
4050 NEXT a% : RETURN
4060 DATA 0,0,0,0,0,0,0,0,0,0,1,0,0,1,1,1,0,0,0,0
4070 DATA 0,0,0,0,0,0,0,0,0,1,3,1,0,1,11,1,0,0,0,0
4080 DATA 0,0,0,0,0,0,0,0,1,3,3,3,1,1,11,1,0,0,0,0
4090 DATA 0,0,0,0,0,0,0,1,3,3,3,3,3,1,11,1,0,0,0,0
4100 DATA 0,0,0,0,0,0,1,3,3,3,3,3,3,3,1,1,0,0,0,0
4110 DATA 0,0,0,0,0,1,3,3,3,3,3,3,3,3,3,1,0,0,0,0
4120 DATA 0,0,0,0,1,3,3,3,3,3,3,3,3,3,3,3,1,0,0,0
4130 DATA 0,0,0,1,10,10,10,10,10,10,1,10,10,10,10,10,10,1,0,0
4140 DATA 0,0,0,1,10,10,10,10,10,1,2,1,10,10,10,10,10,1,0,0
5000 ' Ink Data
5010 RESTORE 5070
5020 FOR i%=0 TO 14
5030   READ c%
5040   INK i%,c%
5050 NEXT i%
5060 RETURN
5070 DATA 1,24,20,6,26,0,2,8,10,12,14,16,18,22,9


[AMSDOS]

I've written this following program, which takes a number from a string array, converts it to it's integer equivalent (still within an array), calculates it into an integer (based on the array positioning) and then converts it back into a string!


Why?!?


Rather trying to explain in words, I'll post this program

Code: [Select]

10 ' Condensed Graphical Numbers Demo
20 '
30 ' A BASIC approach for squeezing more text across the screen (useful in MODE
40 ' 0). I have redefined characters 220 to 229 to become condensed numbers "0"
50 ' to "9".
60 '
70 MODE 0 : INK 1,26 : BORDER 0
80 DIM s$(2),n%(2)
90 s$(0)="1" : s$(1)="0" : s$(2)="0"
100 IF c(1)<>64 THEN GOSUB 1000 ' Define Character Set
110 x% = 0 : y% = 398 : mo% = 4 : GOSUB 520
120 MODE 2 : CALL &BC02 : END
500 ' Convert string number into integer and then
510 ' back to a string (using condensed number set).
520 n%(0)=ASC(s$(0))-48
530 n%(1)=ASC(s$(1))-48
540 n%(2)=ASC(s$(2))-48
550 n%(0)=n%(0)-1
560 n%(1)=n%(1)-1 : IF n%(1)<0 THEN n%(1)=9
570 n%(2)=n%(2)-1 : IF n%(2)<0 THEN n%(2)=9
580 WHILE (n%(1)>-1)
590   WHILE (n%(2)>-1)
600    result%=(n%(1)*10)+n%(2)
610    s$(1)=CHR$(n%(1)+220)
620    s$(2)=CHR$(n%(2)+220)
630    a$=s$(1)+s$(2)
640    GOSUB 2090
650    CALL &BB18
660    n%(2)=n%(2)-1
670  WEND
680  n%(1)=n%(1)-1 : n%(2)=9
690 WEND : RETURN
1000 ' Setup Condensed Character Set
1010 SYMBOL AFTER 219
1020 RESTORE 1060:FOR num%= 220 TO 229
1030  FOR c%=1 TO 8:READ c(c%):NEXT c%
1040  SYMBOL num%,c(1),c(2),c(3),c(4),c(5),c(6),c(7),c(
1050 NEXT num% : RETURN
1060 DATA 64, 160, 224, 224, 160, 160, 64, 0
1070 DATA 64, 192, 64, 64, 64, 64, 224, 0
1080 DATA 64, 160, 32, 64, 64, 128, 224, 0
1090 DATA 64, 160, 32, 64, 32, 160, 64, 0
1100 DATA 32, 160, 160, 224, 32, 32, 32, 0
1110 DATA 224, 128, 192, 32, 160, 160, 64, 0
1120 DATA 64, 160, 128, 192, 160, 160, 64, 0
1130 DATA 224, 32, 32, 64, 64, 128, 128, 0
1140 DATA 64, 160, 160, 64, 160, 160, 64, 0
1150 DATA 64, 160, 160, 96, 32, 160, 64, 0
2000 ' Display Text
2010 ' Entry Conditions:-
2020 '   x% = X coordinate
2030 '   y% = Y coordinate
2040 '   mo% = value relating to screen mode, appropriate values are
2050 '         1 for mode 2, 2 for mode 1 & 4 for mode 0
2060 '   a$ = character string to display, for this program char set 220 to 229
2070 '        are used to appropriately display numbers "0" to "9"
2080 '
2090 FOR p%=1 TO LEN(a$)
2100  TAG
2110  MOVE x%+(mo%*w%),y%
2120  PRINT MID$(a$,p%,1);
2130  w%=w%+4
2140  TAGOFF
2150 NEXT p%
2160 w%=0
2170 RETURN


So what I've done here is setup some Condensed Numbers (char 220-229) , the main work is carried out between 500 to 690, when I first typing this program, I started it as a String Array, immediately I've put that value (100 in this case) into an Integer based array, so num%(0)=1, num%(1)=0 and num%(2)=0 - to get that ASCII is used and subtracted by 48 to get the actual value (lines 520-540). Next I deduct num%(0) so it equals 0 (line 550), so this example only works between 99 & 0. 560 & 570 do the same thing, but subtracting 0 returns -1, so the IF in those lines checks for that and causes num%(1) & num%(2) to equal 9. The Nested WHILE loop I've setup (line 580 & 590) check num%(1) & num%(2) are greater than -1. Line 600 converts the figure from those positions of the array into an Integer value, so the value held in result% can have a value between 0 & 99. 610 & 620 then updates the string values based on the values calculated from the Integer array + 220 to equal the 0-9 values for the condensed characters. a$ (in line 630), which is used for printing the condensed character set can now equal those values in s$(1) & s$(2) and GOSUB 2090 to display.
 
The result% I had in Line 600 isn't doing anything here, but for a game (which is what I was working this for), it can be used to check if a result has been reached. But the conversion of the string array to the Integer based array allows for the necessary calculations, which gets updated to s$(1) & s$(2) for printing the relevant numbers.

[AMSDOS]

I found this last example of 3D ASCII Writing on Rosetta Code (for ZX BASIC), which I quite like, so I wrote one for Locomotive BASIC.    Initially it wasn't perfect, so the screenshot on Rosetta code helped heaps.

Code: [Select]


10 INK 0,0 : INK 1,24 : INK 2,2 : MODE 1
20 d%=0 : c%=2 : GOSUB 50
30 d%=1 : c%=1 : GOSUB 50
40 PEN 1 : END
50 RESTORE
60 FOR n%=1 TO 5
70   READ a$
80   FOR j%=1 TO LEN(a$)
90     PEN c% : LOCATE j%+7+d%,n%+5
100    IF MID$(a$,j%,1)="X" THEN PRINT CHR$(143);
110  NEXT j%
120 NEXT n%
130 RETURN
140 DATA "XXX  XXXX XXX X XXX"
150 DATA "X  X X  X X   X X  "
160 DATA "XXX  XXXX XXX X X  "
170 DATA "X  X X  X   X X X  "
180 DATA "XXX  X  X XXX X XXX"


I'm not sure what the rules are with Rosetta code, so please feel free to post this Locomotive BASIC, I've tried to keep it as close to the ZX BASIC version, so it's interesting to compare.

[AMSDOS]

This is my 2nd version of the Condensed Graphical Numbers I wrote earlier, and it was a lot harder writing it than what I thought be.
My earlier version concentrates on counting down the number sequence from a Nest While Loop, which may have some use in Games, though the Nested Loop would have to be in that Game.
As it is the game I'm writing has Loops galore and it just needs a routine to count down when the Money Bags are being Collected, which I hope this program will address. The program also Loops, but it's a single loop and it's only happening for Demonstration purposes, the main guts has no loops (apart from the FOR loop to help reduce the flickering), so this should help make this program more practical for Games, which just needs a counting sequence, when a certain event occurs in the Game. I've left heaps of comments in this to help explain the process.

Code: [Select]


10 ' Condensed Graphical Numbers Demo 2
20 '
30 ' A BASIC approach for squeezing more text across the screen (useful in MODE
40 ' 0). I have redefined characters 220 to 229 to become condensed numbers "0"
50 ' to "9". Modified original program so no nested loops for counting down the
60 ' numbers, and the program now accepts numbers between 999 and 1. So, this
70 ' routine is more useful for setting a number, and counting down when
80 ' collecting objects in a game. No Nested Loops means this will not be stuck
90 ' carrying out that operation. But Line 110 has a loop in it, so it appears
100 ' to operate similar to the last version.
110 '
120 MODE 0 : INK 1,26 : BORDER 0
130 DIM s$(2),n%(2)
140 n%(0)=9 : n%(1)=9 : n%(2)=9
150 GOSUB 1000 ' Define Character Set
160 x% = 32 : y% = 398 : mo% = 4 : WHILE 1 : GOSUB 610 : WEND
500 ' 610 - this subtracts the 100s counter if 10s & 1s equal 0
510 '       10s & 1s equal 9 when that condition is reached.
520 ' 620 - stores values from n% array as an Integer Variable result%
530 ' 630-650 - converts value from n% array into a String Array.
540 ' 660 - Puts string Arrays into a String for Condensed Number Routine.
550 ' 670 - Condensed Number Routine, x%, y% & mo% were set earlier.
560 ' 680 - Delay loop to reduce flicker.
570 ' 690 - Subtract 1 counter. 10 counter is subtract if not equal to 0
580 '                           AND 1 s counter is less than 0. 1s counter is
590 '                           returned to equal 9.
600 ' 700 - if 100s/10s & 1s counter has reached 0, print final number & exit.
610   IF (n%(1)=0) AND (n%(2)<0) THEN n%(0)=n%(0)-1 : n%(1)=9 : n%(2)=9
620    result%=(n%(0)*100)+(n%(1)*10)+n%(2)
630    s$(0)=CHR$(n%(0)+220)
640    s$(1)=CHR$(n%(1)+220)
650    s$(2)=CHR$(n%(2)+220)
660    a$=s$(0)+s$(1)+s$(2)
670    GOSUB 2090
680    FOR d%=1 TO 100:NEXT d%
690    n%(2)=n%(2)-1 : IF (n%(1)<>0) AND (n%(2)<0) THEN n%(1)=n%(1)-1:n%(2)=9
700    IF (n%(0)=0) AND (n%(1)=0) AND (n%(2)=0) THEN s$(2)=CHR$(220):a$=s$(0)+s$(1)+s$(2):GOSUB 2090:LOCATE 1,10:END
710 RETURN
1000 ' Setup Condensed Character Set
1010 SYMBOL AFTER 219
1020 RESTORE 1060:FOR num%= 220 TO 229
1030  FOR c%=1 TO 8:READ c(c%):NEXT c%
1040  SYMBOL num%,c(1),c(2),c(3),c(4),c(5),c(6),c(7),c(8)
1050 NEXT num% : RETURN
1060 DATA 64, 160, 224, 224, 160, 160, 64, 0
1070 DATA 64, 192, 64, 64, 64, 64, 224, 0
1080 DATA 64, 160, 32, 64, 64, 128, 224, 0
1090 DATA 64, 160, 32, 64, 32, 160, 64, 0
1100 DATA 32, 160, 160, 224, 32, 32, 32, 0
1110 DATA 224, 128, 192, 32, 160, 160, 64, 0
1120 DATA 64, 160, 128, 192, 160, 160, 64, 0
1130 DATA 224, 32, 32, 64, 64, 128, 128, 0
1140 DATA 64, 160, 160, 64, 160, 160, 64, 0
1150 DATA 64, 160, 160, 96, 32, 160, 64, 0
2000 ' Display Text
2010 ' Entry Conditions:-
2020 '   x% = X coordinate
2030 '   y% = Y coordinate
2040 '   mo% = value relating to screen mode, appropriate values are
2050 '         1 for mode 2, 2 for mode 1 & 4 for mode 0
2060 '   a$ = character string to display, for this program char set 220 to 229
2070 '        are used to appropriately display numbers "0" to "9"
2080 '
2090 FOR p%=1 TO LEN(a$)
2100  TAG
2110  MOVE x%+(mo%*w%),y%
2120  PRINT MID$(a$,p%,1);
2130  w%=w%+4
2140  TAGOFF
2150 NEXT p%
2160 w%=0
2170 RETURN


[AMSDOS]

I've came up with some routines for drawing some Block Graphics in Mode 0. Initially I was trying to Scroll some Block Graphics with SCR FILL BOX, but was doing my head in. 
Earlier I was also using TAG and character 133 to make up some text (specifically with the 3D text routine), but had problems when bits of that was disappearing, I change the Write mode to XOR. but then the colour was clashing and had to set another ink colour to get the right colours, so I wrote a routine in BASIC to draw a block which worked.
Today I've updated the code to draw a block from Assembly and make some BASIC demonstration programs from it to produce some colourful Square Block Effects from Mode 0, my second program (shown below) includes some data to display a Welcome Message which gets drawn using Square Effects (I just decided to randomise those Colours), once that's complete Left and Right Arrow can be used to Print some Coloured Blocks along the Left and Right Edge of the Screen,  so it's quite silly!

Code: [Select]

100 MODE 0
110 IF PEEK(&4000)<>6 THEN GOSUB 1000
120 GOSUB 2000
130 INK 14,11:INK 15,9
140 a%=0:y2%=0
150 WHILE a%<29
160 FOR y%=174 TO 238 STEP 16
170   x%=624
180   IF ob%(a%,y2%)=1 THEN c%=INT(RND*14)+1 : CALL &4000,x%,y%,c%
190   y2%=y2%+1
200 NEXT y%
210 CALL &403C:a%=a%+1:y2%=0
220 WEND
230 WHILE INKEY(18)=-1
240   IF INKEY(1)<>-1 THEN CALL &403C:x%=624:c%=INT(RND*14)+1:GOSUB 280
250   IF INKEY(8)<>-1 THEN CALL &4045:x%=0:c%=INT(RND*14)+1:GOSUB 280
260 WEND
270 WHILE INKEY$<>"":WEND:MODE 2:END
280 FOR y%=398 TO 8 STEP -16
290   IF c%<>0 THEN c%=INT(RND*14)+1
300   CALL &4000,x%,y%,c%
310 NEXT y%
320 RETURN
1000 RESTORE 1050
1010 FOR a%=&4000 TO &4051
1020   READ a$
1030   POKE a%,VAL("&"+a$)
1040 NEXT:RETURN
1050 DATA 06,08,DD,7E,00,CD,DE,BB,DD,6E,02,DD,66,03,22,50
1060 DATA 40,EB,DD,6E,04,DD,66,05,22,4E,40,C5,2A,4E,40,EB
1070 DATA 2A,50,40,CD,C0,BB,21,0C,00,EB,21,00,00,CD,F9,BB
1080 DATA C1,2A,50,40,2B,2B,22,50,40,10,E0,C9,CD,0B,BC,23
1090 DATA 23,CD,05,BC,C9,CD,0B,BC,2B,2B,CD,05,BC,C9,00,00
1100 DATA 00,00
2000 RESTORE 2080 : DIM ob%(28,4)
2010 FOR x%=0 TO 28
2020   FOR y%=4 TO 0 STEP -1
2030    READ n%
2040    ob%(x%,y%)=n%
2050   NEXT y%
2060 NEXT x%
2070 RETURN
2080 DATA 1,1,1,1,1
2090 DATA 0,0,1,1,0
2100 DATA 1,1,1,1,1
2110 DATA 0,0,0,0,0
2120 DATA 1,1,1,1,1
2130 DATA 1,0,1,0,1
2140 DATA 1,0,0,0,1
2150 DATA 0,0,0,0,0
2160 DATA 1,1,1,1,1
2170 DATA 0,0,0,0,1
2180 DATA 0,0,0,0,1
2190 DATA 0,0,0,0,0
2200 DATA 0,1,1,1,0
2210 DATA 1,0,0,0,1
2220 DATA 1,0,0,0,1
2230 DATA 0,0,0,0,0
2240 DATA 0,1,1,1,0
2250 DATA 1,0,0,0,1
2260 DATA 0,1,1,1,0
2270 DATA 0,0,0,0,0
2280 DATA 1,1,1,1,1
2290 DATA 0,1,1,0,0
2300 DATA 1,1,1,1,1
2310 DATA 0,0,0,0,0
2320 DATA 1,1,1,1,1
2330 DATA 1,0,1,0,1
2340 DATA 1,0,0,0,1
2350 DATA 0,0,0,0,0
2360 DATA 1,1,1,0,1


[attachimg=1]

[AMSDOS]

Following on from my last post, I've made some adjustments to the Draw Block routine, so now it's possible to set Width & Height of the Block, which could be anything from a pixel 1 x 1 to the whole screen 640x200 can be drawn. I didn't write it just to fill in the whole screen, though now various Block Sizes can be used, which I hope could be useful for defining different block sizes.

Code: [Select]

org &4000


;; Draw a Block
;; CALL &4000,<xpos>,<ypos>,<width>,<height>,<col>


.begin ld a,(ix+02)
ld b,a
ld l,(ix+04)
ld h,(ix+05)
ld (width),hl
ld a,(ix+00)
call &bbde
ld l,(ix+06)
ld h,(ix+07)
ld (ypos),hl
ex hl,de
ld l,(ix+08)
ld h,(ix+09)
ld (xpos),hl
.loop
push bc
ld hl,(xpos)
ex hl,de
ld hl,(ypos)
call &bbc0
ld hl,(width)
ex hl,de
ld hl,0
call &bbf9
pop bc
ld hl,(ypos)
dec hl
dec hl
ld (ypos),hl
djnz loop
ret


.xpos defw 0
.ypos defw 0
.width defw 0






Code: [Select]

10 INK 0,0 : INK 1,25 : INK 2,2 : MODE 0
20 IF PEEK(&4000)<>&DD THEN GOSUB 2020
30 x%=214 : y%=0 : c%=2 : GOSUB 60
40 x%=222 : y%=0 : c%=1 : GOSUB 60
50 LOCATE 1,15 : END
60 RESTORE 160
70 FOR n%=1 TO 5
80   READ a$
90   FOR j%=1 TO LEN(a$)
100    IF MID$(a$,j%,1)="X" THEN GOSUB 1040
110    w%=w%+2
120  NEXT j%
130  w%=0 : y%=y%+8
140 NEXT n%
150 RETURN
160 DATA "X  X XXXX X    X    XXXX"
170 DATA "X  X X    X    X    X  X"
180 DATA "XXXX XXX  X    X    X  X"
190 DATA "X  X X    X    X    X  X"
200 DATA "X  X XXXX XXXX XXXX XXXX"
1000 ' Draw Square Block
1010 ' x% = graphical xpos.
1020 ' y% = graphical ypos.
1030 ' c% = graphical pen.
1040 CALL &4000,x%+(4*w%),398-y%,4,4,c%
1050 RETURN
2000 ' Draw a Block M/C Routine
2010 ' To use CALL &4000,<xpos>,<ypos>,<width>,<height>,<colour>
2020 MEMORY &3FFF
2030 RESTORE 2090
2040 FOR addr%=&4000 TO &404F
2050   READ a$
2060   POKE addr%,VAL("&"+a$)
2070 NEXT addr%
2080 RETURN
2090 DATA DD,7E,02,47
2100 DATA DD,6E,04,DD
2110 DATA 66,05,22,4B
2120 DATA 40,DD,7E,00
2130 DATA CD,DE,BB,DD
2140 DATA 6E,06,DD,66
2150 DATA 07,22,49,40
2160 DATA EB,DD,6E,08
2170 DATA DD,66,09,22
2180 DATA 47,40,C5,2A
2190 DATA 47,40,EB,2A
2200 DATA 49,40,CD,C0
2210 DATA BB,2A,4B,40
2220 DATA EB,21,00,00
2230 DATA CD,F9,BB,C1
2240 DATA 2A,49,40,2B
2250 DATA 2B,22,49,40
2260 DATA 10,E0,C9,00
2270 DATA 00,00,00,00
2280 DATA 00,00,00,00

[Gryzor]

Aw this is really cute

[AMSDOS]

Aw this is really cute  

It's definitely 10-Liner material, so I'll have a go at making it one (which I'm not very good at).


  


Well it was very manageable, managed to write it all with 3 Lines to Spare!    Though I recoded the M/C Data and Array Data, so it's all done in 1 Line each, the good news is no GOTOs were necessary. 


[attachimg=1]


I could of use the same approach in Line 6 as I did in Line 7 for poking the M/C, though it's good to show different approaches, so have left it like that. 


I've attached a file so no need to type it in, otherwise be careful typing it in, the M/C isn't Data Checked.

[Gryzor]

I hope you don't mind me posting the code here for easy copying and pasting

Code: [Select]


1 DEFINT a-z:DIM o(28,4):GOSUB 7:GOSUB 6:MODE 0:INK 5,15:INK 14,11:INK 15,9:a=0:y2=0
2 WHILE a<29:FOR y=174 TO 238 STEP 16:x=624:IF o(a,y2)=1 THEN c=INT(RND*14)+1:CALL &4000,x,y,c
3 y2=y2+1:NEXT y:CALL &403C:a=a+1:y2=0:WEND:WHILE INKEY(18)=-1:IF INKEY(1)<>-1 THEN CALL &403C:x=624:c=INT(RND*14)+1:GOSUB 5:ELSE IF INKEY(8)<>-1 THEN CALL &4045:x=0:c=INT(RND*14)+1:GOSUB 5
4 WEND:WHILE INKEY$<>"":WEND:MODE 2:END
5 FOR y=398 TO 8 STEP -16:IF c<>0 THEN c=INT(RND*14)+1:CALL &4000,x,y,c:NEXT y:RETURN
6 p=0:READ a$:FOR a=0 TO 77:POKE &4000+a,VAL("&"+MID$(a$,p+1,2)):p=p+2:NEXT a:RETURN:DATA 0608DD7E00CDDEBBDD6E02DD6603225040EBDD6E04DD6605224E40C52A4E40EB2A5040CDC0BB210C00EB210000CDF9BBC12A50402B2B22504010E0C9CD0BBC2323CD05BCC9CD0BBC2B2BCD05BCC9
7 w$="1111100110111110000011111101011000100000111110000100001000000111010001100010000001110100010111000000111110110011111000001111110101100010000011101":p=1:FOR x=0 TO 28:FOR y=4 TO 0 STEP -1:o(x,y)=VAL(MID$(w$,p,1)):p=p+1:NEXT y:NEXT x:RETURN

[Morri]

Looks like the beginnings of a cool demo scroller. 

[AMSDOS]

Looks like the beginnings of a cool demo scroller. 

It's not really something I was taking seriously, when I got it down to 7 Lines I was thinking of David Hall's Omega Scroll 10-Liner, though that allows you to Enter the Text you wish to scroll, I'm unsure if it worked on the 464 though, which came out as Gibberish.


EDIT: Oddly enough I had a look at that Omega Scroll program on my 464 Emulator and it worked just fine, so that Gibberish that must of occurred was probably me typing it in incorrectly.    For some reason I thought I had the same program from when I was using a 464 to when I upgraded to the 6128, unfortunately I don't have a real 464 to test this, but I think most likely I typed the program in with errors.

[AMSDOS]

Following on the theme of 10 Liners, I was looking at the condensed text (4x8) program I wrote earlier and suddenly realised the data from the symbol definitions fits in nicely with the Sixteen Times Table, so can write a program like this:

Code: [Select]

1 DEFINT a-z:SYMBOL AFTER 229:DIM o(8,26):GOSUB 9:MODE 0:INK 1,26:TAG:c=230:FOR x=0 TO 400 STEP 16:MOVE x,398:PRINT CHR$(c);:c=c+1:NEXT x:CALL &BB18:END
9 d$="2557555065565560254445206555556074464470744644402547552055575550722222701111152055665550444444705775555015777550755555706556444025555521655655502542152072222220555555705555522055557750557275505552222071222470"
10 p=1:FOR c=1 TO 26:FOR d=1 TO 8:o(d,c)=VAL(MID$(d$,p,1))*16:p=p+1:NEXT d:SYMBOL c+229,o(1,c),o(2,c),o(3,c),o(4,c),o(5,c),o(6,c),o(7,c),o(8,c):NEXT c:RETURN


which lets me redefine the entire alphabet. I've redefined it from characters 230 to 255, so like my last 10 Liner I've set up a string in Line 9 which holds VALues which, when they are multiplied by 16 in Line 10, the corresponding value gets stored into the array, when d in the FOR loop reaches 8 or 9, the loop exits and SYMBOL redefines the data from the array, when that's done the program returns and a short demonstration follows on Line 1.


But I thought it someone wanted to create a simple 10 Liner game with Condensed text, that is probably the best approach. It may also be possible to squeeze numbers into those 2 Lines, unfortunately my condensed numbers need some shifting as larger values are being used in my SYMBOL redefining.

[AMSDOS]

Another BASIC program for the Silly Vaults, again a Bouncing Ball routine with Transparent Mode On & Off. Initially I was filling in the centre of the Ball, though changed that to use 1 redefined character & PAPER to do the same thing with Transparent Mode turned off. I can then turn on Transparent Mode to print the Middle colour in the Ball. The effect looks better with a Background, though for the Background to work I need to Redefine another Character to print around the Ball, this is when BASIC starts revealing itself because in order to Print the 1st Character with the Transparent Mode turned off, the area around the Ball is cleared, I then turn on Transparent Mode, Print the area around the Outer Edge of the Ball, followed by the middle colour, so when the program is on display a Square effect is noticeable (as my 2nd Screen shot will show). I've taken the liberty to apply the Print Ball/Enter Loop/Delete Ball/Print Ball in the next position approach as that seems to work best in BASIC in helping to reduce flicker.

Code: [Select]


10 DEFINT a-z:MODE 0
20 SYMBOL 255,56,68,130,130,130,68,56,0
30 SYMBOL 254,130,1,0,1,0,1,130,85
40 SYMBOL 253,0,0,8,0,0,0,0,0
50 INK 0,0:INK 1,1:INK 2,2:INK 3,11:INK 4,18:PAPER 2:BORDER 2:CLS
60 GOSUB 380
70 x=10 : y=10 : e=1 : f=1
80 GOSUB 250
90 WHILE INKEY(18)=-1
100 CALL &BD19:CALL &BD19
110 IF x=20 THEN e=-1
120 IF x=1 THEN e=1
130 IF y=25 THEN f=-1
140 IF y=1 THEN f=1
150 GOSUB 350
160 x=x+e
170 y=y+f
180 GOSUB 250
190 WEND
200 CALL &BC02 : INK 1,26 : PEN 1
210 PRINT CHR$(22);CHR$(0);
220 MODE 2
230 END
240 ' Draw Ball
250 PEN 1
260 LOCATE 1,1:PRINT CHR$(22);CHR$(0);
270 LOCATE x,y : PRINT CHR$(255);
280 PEN 4
290 LOCATE 1,1:PRINT CHR$(22);CHR$(1);
300 LOCATE x,y : PRINT CHR$(254);
310 PEN 3
320 LOCATE x,y : PRINT CHR$(253);
330 RETURN
340 ' Erase Ball
350 PEN 4 : LOCATE 1,1:PRINT CHR$(22);CHR$(0);:LOCATE x,y : PRINT CHR$(207);
360 RETURN
370 ' Draw Background
380 FOR y=1 TO 25
390 PEN 4
400 LOCATE 1,y
410 PRINT STRING$(20,CHR$(207));
420 NEXT y
430 RETURN


[AMSDOS]

Back to this old thread, I've made a couple of updates to this old thing from Nov 2011:

Code: [Select]

10 MODE 1
20 xc=2:yc=2:x=0:y=0
30 WHILE INKEY$=""
40 CALL &BD19:CALL &BD19:CALL &BD19:CALL &BD19:ORIGIN x,y:PLOT 100,100,1:DRAW 125,100:DRAW 125,125:DRAW 100,125:DRAW 100,100
50 ox=x:oy=y:x=x+xc:y=y+yc
60 CALL &BD19:CALL &BD19:CALL &BD19:CALL &BD19:ORIGIN ox,oy:PLOT 100,100,0:DRAW 125,100:DRAW 125,125:DRAW 100,125:DRAW 100,100
70 IF x=100 then xc=-2
80 if y=100 then yc=-2
90 if x=0 then xc=2
100 if y=0 then yc=2
110 wend

As it shows is using a heap of FRAME FLYBACKs (&BD19), though still flickers.  What I should of done was:

Code: [Select]

25 ORIGIN x,y:PLOT 100,100,1:DRAW 125,100:DRAW 125,125:DRAW 100,125:DRAW 100,100
35 ox=x:oy=y:x=x+xc:y=y+yc
40 ORIGIN ox,oy:PLOT 100,100,0:DRAW 125,100:DRAW 125,125:DRAW 100,125:DRAW 100,100
50 ORIGIN x,y:PLOT 100,100,1:DRAW 125,100:DRAW 125,125:DRAW 100,125:DRAW 100,100
DELETE 60

though rather than drag that program out any further, I wanted to have some fun with this idea of adding a couple more shapes to it and see how BASIC handles it.

I was quite surprised how well this 1st program went. I've kept it to a series of 3 shapes with their own set of variables, so shape 1 uses x & y, shape 2 uses w & z and shape 3 uses u & v. They each have their own directional variables, shape 1 uses a & b to allow it to move diagonally like the original program did, shape 2 uses c to move the shape horizontally across the screen & shape 3 uses d which moves the shape vertically up and down the screen, to make things a little bit more interesting shape 3 begins moving very slowly, though once it reaches of one those checkpoints it could speed up. Using this approach yes it possible to move a series of graphical shapes by just using ORIGIN:

Code: [Select]

10 ' Attack of the Moving Shapes!
20 ' Simulate the Movement of Multiple Shapes using ORIGIN in Locomotive BASIC
30 ' 3 Shapes are used: Square, Triangle & Rectangle
40 ' Related Variables for each shape are:
50 ' Square,   x, y = xpos,ypos positions,
60 '           a, b = directional guides to move square Diagonally
70 ' Triangle, w, z = xpos,ypos positons, c = directional guide
80 ' Rectangle,u, v = xpos,ypos positions, d = directional guide
90 ' An leading 'o' followed by variable is used for deleting an old position.
100 MODE 0:BORDER 11:INK 0,11:INK 1,26
110 PRINT CHR$(23)+CHR$(1); ' XOR Mode
120 a%=4:b%=4:c%=8:d%=2
130 x%=100:y%=100
140 w%=296:z%=300
150 u%=304:v%=12
160 ORIGIN x%,y%:GOSUB 1010
170 ORIGIN w%,z%:GOSUB 1110
180 ORIGIN u%,v%:GOSUB 1210
190 WHILE INKEY(47)=-1
200   ox%=x%:oy%=y%
210   ow%=w%
220   ov%=v%
230   x%=x%+a%:y%=y%+b%
240   w%=w%+c%
250   v%=v%+d%
260   ORIGIN ox%,oy%:GOSUB 1010
270   ORIGIN ow%,z%:GOSUB 1110
280   ORIGIN u%,ov%:GOSUB 1210
290   ORIGIN x%,y%:GOSUB 1010
300   ORIGIN w%,z%:GOSUB 1110
310   ORIGIN u%,v%:GOSUB 1210
320   IF x%=200 THEN a%=-4
330   IF y%=200 THEN b%=-4
340   IF x%=0 THEN a%=4
350   IF y%=0  THEN b%=4
360   IF w%=600 THEN c%=-8
370   IF w%=0 THEN c%=8
380   IF v%>370 THEN d%=-INT(RND*7)+2
390   IF v%<10 THEN d%=INT(RND*7)+2
400 WEND:MODE 2:END
1000 ' Draw Box
1010 PLOT 0,0,1
1020 DRAW 25,0
1030 DRAW 25,25
1040 DRAW 0,25
1050 DRAW 0,0
1060 RETURN
1100 ' Draw Triangle
1110 PLOT 0,0,2
1120 DRAW 25,0
1130 MOVE 25,2:DRAW 12,25
1140 MOVE 10,18:DRAW 0,0
1150 RETURN
1200 ' Draw Rectangle
1210 PLOT 0,0,3
1220 DRAW 50,0
1230 DRAW 50,25
1240 DRAW 0,25
1250 DRAW 0,2
1260 RETURN

I then decided to bring more organization to the program by using an array instead. Applying it that way, it's introduced some FOR loops to deal with the positions for the 3 shapes & reduced the amount of variable/ORIGIN being used and have been able to use ON p% GOSUB for the corresponding shape, I was hoping I would have been able to do something to that large summary of IF statements (340..410), though as each shape has it's own personal traits, the conditions need to remain (unless there's another way around it!):

Code: [Select]

10 ' ------------------------------------------------------------------
20 ' Attack of the Moving Shapes #2!
30 '
40 ' Simulate the Movement of 3 Shapes using ORIGIN.
50 ' In this version the 3 Shapes positions are stored into 4 Arrays to
60 ' represent Current and Old positions. 1,2 & 3 represent each Shape.
70 ' The p% variable is used to point to the relevant position of the
80 ' array and print the relevant shape subroutine.
90 ' ------------------------------------------------------------------
100 MODE 0:BORDER 11:INK 0,11:INK 1,26
110 DIM x%(3),y%(3),ox%(3),oy%(3)
120 PRINT CHR$(23)+CHR$(1); ' XOR Mode
130 a%=4:b%=4:c%=8:d%=2
140 x%(1)=100:y%(1)=100
150 x%(2)=296:y%(2)=300
160 x%(3)=304:y%(3)=12
170 FOR p%=1 TO 3
180   ORIGIN x%(p%),y%(p%)
190   ON p% GOSUB 1010,1110,1210
200 NEXT p%
210 WHILE INKEY(47)=-1
220   FOR p%=1 TO 3
230    ox%(p%)=x%(p%):oy%(p%)=y%(p%)
240   NEXT p%
250   x%(1)=x%(1)+a%:y%(1)=y%(1)+b%
260   x%(2)=x%(2)+c%
270   y%(3)=y%(3)+d%
280   FOR p%=1 TO 3
290     ORIGIN ox%(p%),oy%(p%)
300     ON p% GOSUB 1010,1110,1210
310     ORIGIN x%(p%),y%(p%)
320     ON p% GOSUB 1010,1110,1210
330   NEXT p%
340   IF x%(1)=200 THEN a%=-4
350   IF y%(1)=200 THEN b%=-4
360   IF x%(1)=0 THEN a%=4
370   IF y%(1)=0  THEN b%=4
380   IF x%(2)=600 THEN c%=-8
390   IF x%(2)=0 THEN c%=8
400   IF y%(3)>370 THEN d%=-INT(RND*7)+2
410   IF y%(3)<10 THEN d%=INT(RND*7)+2
420 WEND:WHILE INKEY$<>"":WEND:MODE 2:END
1000 ' Draw Box
1010 PLOT 0,0,1
1020 DRAW 25,0
1030 DRAW 25,25
1040 DRAW 0,25
1050 DRAW 0,0
1060 RETURN
1100 ' Draw Triangle
1110 PLOT 0,0,2
1120 DRAW 25,0
1130 MOVE 25,2:DRAW 12,25
1140 MOVE 10,18:DRAW 0,0
1150 RETURN
1200 ' Draw Rectangle
1210 PLOT 0,0,3
1220 DRAW 50,0
1230 DRAW 50,25
1240 DRAW 0,25
1250 DRAW 0,2
1260 RETURN
The result for the second program is something which is slower than the 1st, though offers much less flicker. 

[AMSDOS]

I'd made some adjustments to that condensed character set program above to produce a short Multicoloured Character demonstration program.


Initially my program looked like this:

Code: [Select]


10 SYMBOL 255,48,80,136,136,132,132,132,132
20 SYMBOL 254,0,32,80,32,80,40,80,40
30 SYMBOL 253,0,4,8,8,16,32,32,16
40 SYMBOL 252,0,0,4,4,12,28,28,0
50 SYMBOL 251,0,0,2,2,2,2,2,12
60 SYMBOL 250,0,56,72,68,100,56,0,0
70 SYMBOL 249,0,0,48,56,24,0,0,0
80 mode 0:ink 0,11:ink 1,26:ink 2,12:ink 3,9:ink 5,20:ink 6,23:ink 7,9:ink 8,10:ink 9,18
90 print chr$(22);chr$(1);
100 locate 1,1:pen 2:print chr$(255);:locate 1,1:pen 3:print chr$(254);
110 locate 3,1:pen 7:print chr$(253);:locate 3,1:pen 9:print chr$(252);:locate 3,1:pen 8:print chr$(251);
120 locate 5,1:pen 6:print chr$(250);:locate 5,1:pen 5:print chr$(249);
130 print chr$(22);chr$(0);


with some adjustments I'm able to have the character set as data within a string and use ASC to return it's value into an array.


[attachimg=1]


with the character data that SYMBOL uses in the 1st program, I just used CHR(<num>) to get the appropriate characters. If the character is a control code (which fall in the range of 0..31), CHR(1);CHR(<num>) needs to be used to display it, otherwise the manual documents how to access the control code through the CTRL+<key> method. I just then used CTRL+Arrow Keys to select the characters required for the string. The only limitation I had was not being able to access CHR(0) which is not accessible through Cursor Copy, as a result I picked another character which was not being used (255 seemed a good start!), though because of that, I've had to write an conditional "IF" for it. So this program could be improved if all 8 lines are used to avoid having any 0's in the SYMBOL data. The rest of my program just demonstrates randomly selecting from the 3 characters available and randomly position them onscreen, this code is using the transparent mode and the characters are positioned based on text coordinate positions, overall this looks quite quick and could be used instead of Ariom Sprites for the 10-Liners Compo.


[attachimg=2]

[AMSDOS]

I've been working on another approach for redefining the symbol data, this is what I came up with, which is just an example of the program above:

Code: [Select]

1000 DEFINT a-z:DIM g(18),d(8):p=1:READ a$:FOR z=1 TO 18:g(z)=VAL("&"+MID$(a$,p,2)):p=p+2:NEXT z:woff$=CHR$(22)+CHR$(0):b$="AAKLGAAAALNMPLAAAABBBBBEAACCEHHAACDDFIIFAIOIOJOJKORRQQQQ":DATA 000204080C10181C20283038444850648488
1010 p=1:FOR c=249 TO 255:FOR q=1 TO 8:y=ASC(MID$(b$,p,1))-64:d(q)=g(y):p=p+1:NEXT q:SYMBOL c,d(1),d(2),d(3),d(4),d(5),d(6),d(7),d(8):NEXT c:MODE 0:INK 0,0:INK 1,26:INK 2,12:INK 3,9:INK 5,23:INK 6,20:INK 7,9:INK 8,18:INK 9,10:won$=CHR$(22)+CHR$(1)
1020 PRINT won$;:FOR z=1 TO 50:x=INT(RND*20)+1:y=INT(RND*25)+1:s=INT(RND*3)+1:ON s GOSUB 1030,1040,1050:NEXT z:PRINT woff$;:LOCATE 1,1:PEN 1:CALL &BB18:END
1030 i=3:FOR c=254 TO 255:LOCATE x,y:PEN i:PRINT CHR$(c);:i=i-1:NEXT c:RETURN
1040 i=6:FOR c=249 TO 250:LOCATE x,y:PEN i:PRINT CHR$(c);:i=i-1:NEXT c:RETURN
1050 i=9:FOR c=251 TO 253:LOCATE x,y:PEN i:PRINT CHR$(c);:i=i-1:NEXT c:RETURN

Lines 1000 & 1010 do all the hard work of preparing the data and redefining accordingly. The DATA line in 1000 contains the figures (in Hexadecimal format) which gets stored in the g array. The b$ string is also data, since there are more than 10 combinations due to the amount of data values, I've used an alphabetical approach, which is converted into a value using ASC and subtracted by 64 to return a pointer type position that's stored into the "y" variable which in turn is then used to get the correct value from within the g array.

I made this routine because the game I'm working on now has quite a few redefined symbols, this example from the program above however, shows that I was able to simply redefine the symbols within 1 line, this approach obviously needs 2 lines. What I have here maybe the same as having the symbol data in 2 lines, maybe one advantage with this routine might be the ability of having DATA on any line filling in any gaps where necessary or just making it harder to decipher the code (though it doesn't help explaining the process here!)