MlNR Created at Oct 2, Tue, 22:33.25 TURTLE:BITRESERVE.TEXT program bit_map_reserve; (* Utility used for pre-reserving space for bit-map mode programs *) (* A-DATA 860604 *) uses screenops; var prline :sc_long_string; ret_set :sc_chset; ch :char; procedure interpreter(ch :char); (* Command line interpreter *) const intmem = 10112; (* Interpreters VDP memory pointer *) topmem = 10114; (* Top VDP memory pointer *) newint = 14360; (* New intmem value *) stdint = 3576; (* Standard intmem value *) type dual = record case boolean of true :(int :integer); false:(ptr :^integer); end; (* dual *) procedure poke(addr,value :integer); var window :dual; begin window.int := addr; window.ptr^ := value; end; (* poke *) function peek(addr :integer):integer; var window :dual; begin window.int := addr; peek := window.ptr^; end; (* peek *) procedure clearline; (* Clears common prompt line *) begin sc_gotoxy(0,1); sc_clrcurline; end; (* clearline *) procedure allocate; (* Reserves space for bit-map mode *) begin clearline; if peek(topmem)=deltax then begin error := error-deltax; y := y+yinc; end; x := x+xinc; drawdot; i := i-1; until i=0; end; (* doforx *) procedure dofory; (* More vertical *) var error, i :integer; begin error := deltay div 2; i := deltay; repeat error := error+deltax; if error>=deltay then begin error := error-deltay; x := x+xinc; end; y := y+yinc; drawdot; i := i-1; until i=0; end; (* dofory *) begin (* drawline *) x := xstart; if deltax<0 then begin xinc := -1; deltax := -deltax; end else xinc := 1; y := ystart; if deltay<0 then begin yinc := -1; deltay := -deltay; end else yinc := 1; count := 0; if deltax>=deltay then doforx else dofory; if ink=4 then (* radar *) range := count; (* Hit the limit given *) end; (* drawline *) begin (* main *) writeln('Now just look at this fantastic'); writeln('graphic demonstration'); grafmode; y := 0; while y<96 do begin drawline(temp,32+y,y,191-2*y,0,1); drawline(temp,32+y,191-y,191-2*y,0,1); drawline(temp,32+y,y,0,191-2*y,1); drawline(temp,223-y,y,0,191-2*y,1); y := y+4; end; textmode; end. Created at Oct 2, Tue, 22:34.23 TURTLE:BITMAPPAS2.TEXT program testbitmap; var temp, y, i, xmin, xmax, ymin, ymax :integer; procedure bitmap(var buffer); external; procedure nobitmap(var buffer); external; procedure drawline(var range:integer; xstart,ystart,deltax,deltay,ink:integer); external; procedure grafmode; var buffer :array[0..499] of integer; (* Size 1000 bytes *) begin bitmap(buffer); end; (* grafmode *) procedure textmode; var buffer :array[0..499] of integer; begin nobitmap(buffer); end; (* textmode *) begin (* main *) writeln('Now just look at this fantastic'); writeln('graphic demonstration'); xmin := 0; xmax := 255; ymin := 0; ymax := 191; grafmode; y := 0; while y<96 do begin drawline(temp,32+y,y,191-2*y,0,1); drawline(temp,32+y,191-y,191-2*y,0,1); drawline(temp,32+y,y,0,191-2*y,1); drawline(temp,223-y,y,0,191-2*y,1); y := y+4; end; textmode; end. Created at Oct 2, Tue, 22:34.36 TURTLE:BITUASM.TEXT .PAGEHEIGHT 65 .TITLE "Low-level bit-map mode drivers" ;---------------------------------------- ; ; Low level bit-map mode drivers ; A-DATA 870206 ; SP .EQU 10 PASCALWS .EQU 8380H VDPRD .EQU 8800H ;VDP read data address VDPWD .EQU 8C00H ;VDP write data address VDPWA .EQU 8C02H ;VDP write address address KEYBUFPNT: .EQU 288AH ;Keyboard buffer pointer LAYOUTPNT: .EQU 288CH ;Keyboard layout pointer KEYBUF1 .EQU 0BE0H ;Normal key buffer KEYBUF2 .EQU 1B80H ;Bit-map key buffer LAYOUT1 .EQU 0D80H ;Normal layout area LAYOUT2 .EQU 1BA0H ;Bit-map layout area REGCOPY .EQU 2810H ;PME copy table of VDP R1..R7 PATTERN1 .EQU 0 ;Pattern generator table PATTERN2 .EQU 2000H COLTAB1 .EQU 0BC0H ;Color table COLTAB2 .EQU 0 IMAGE1 .EQU 0800H ;Screen image table IMAGE2 .EQU 1800H SAB1 .EQU 0C00H ;Sprite attribute table SAB2 .EQU 1B00H SAVE2A .EQU 1C18H ;Otherwise unused area between tables ; Now used to hold character definitions SAVE2B .EQU 3800H ;Additional save area .INCLUDE BITUASM.1.TEXT ;--------------------- ; ; procedure drawline(var range:integer; ; xstart,ystart,deltax,deltay,ink,mode:integer); ; ; This procedure is a modified copy of the Pascal drawline procedure, as it is ; described in the II.0 System manual. ; Color handling is added, compared to the original. ; Local variables are allocated in DRAWWS as follows. ; ;---------- ; Register usage (DRAWWS) ; ; R0 i ; R1 error ; R2 x ; R3 y ; R4 xinc ; R5 yinc ; R6 count ; R7 Secondary return link ; R8 mode ; R9 ^range ; R10 ink ; R11 Return link ; R12 xstart ; R13 ystart ; R14 deltax ; R15 deltay ; ;---------- .PROC DRAWLINE,7 .PUBLIC XMIN,XMAX,YMIN,YMAX .DEF DRAWWS .REF VSBR,VSBW MOV *SP+,@DRAWWS+16 ;mode MOV *SP+,@DRAWWS+20 ;ink MOV *SP+,@DRAWWS+30 ;deltay MOV *SP+,@DRAWWS+28 ;deltax MOV *SP+,@DRAWWS+26 ;ystart MOV *SP+,@DRAWWS+24 ;xstart MOV *SP+,@DRAWWS+18 ;range LWPI DRAWWS SLA R8,1 ;Mode should be used as a word index MOV R12,R2 ;x := xstart CI R14,-1 ;if deltax<0 JGT DXPOS SETO R4 ;xinc := -1 NEG R14 ;deltax := -deltax JMP ENDIF1 DXPOS LI R4,1 ;xinc := 1 ENDIF1 MOV R13,R3 ;y := ystart CI R15,-1 ;if deltay<0 JGT DYPOS SETO R5 ;yinc := -1 NEG R15 ;deltay := -deltay JMP ENDIF2 DYPOS LI R5,1 ;yinc := 1 ENDIF2 CLR R6 ;count := 0 C R14,R15 ;if deltax>=deltay JL DOY BL @DOFORX JMP ENDIF3 DOY BL @DOFORY ENDIF3 LWPI PASCALWS B *R11 ;---------- DRAWDOT MOV R11,@SAVRTN MOV @JMPTBLE1(R8),R11 B *R11 ; Action table for first selection JMPTBLE1 .WORD ENDIF3 .WORD SOMESET,SOMESET,SOMESET,SOMESET .WORD ENDIF3 .WORD SOMESET,SOMESET,SOMESET .WORD RADAR SAVRTN .WORD 0 SOMESET BLWP @SETSCREEN MOV @SAVRTN,R11 B *R11 ; Radar has been modified to include out of bounds checking. CHECK now returns ; with the carry bit set if some limit has been exceeded. Drawline then returns ; with range set to -1. RADAR MOV @SAVRTN,R11 INC R6 ;count := count+1 BLWP @GETSCREEN ;(x,y) JOC RANGE1 JEQ GOTIT INC R3 BLWP @GETSCREEN ;(x,y+1) JOC RANGE2 JNE NOT1 DEC R3 INC R2 BLWP @GETSCREEN ;(x+1,y) JOC RANGE3 JNE NOT2 DEC R2 GOTIT MOV R6,*R9 ;range := count JMP ENDIF3 ;exit NOT1 DEC R3 B *R11 NOT2 DEC R2 B *R11 RANGE2 DEC R3 RANGE1 SETO *R9 ;Indicate out of range without intersection JMP ENDIF3 RANGE3 DEC R2 JMP RANGE1 ;----------- DOFORX MOV R11,R7 CI R14,0 ;if deltax=0 JEQ ENDIF3 ;exit MOV R14,R1 ;error := deltax div 2 SRA R1,1 MOV R14,R0 ;i := deltax REPEAT1 A R15,R1 ;error := error+deltay C R1,R14 ;if error>=deltax JLT ENDIF5 S R14,R1 ;error := error-deltax A R5,R3 ;y := y+yinc ENDIF5 A R4,R2 ;x := x+xinc BL @DRAWDOT DEC R0 ;i := i-1 JNE REPEAT1 B *R7 ;---------- DOFORY MOV R11,R7 MOV R15,R1 ;dofory is a copy of the pascal version, just like SRA R1,1 ;doforx. MOV R15,R0 REPEAT2 A R14,R1 C R1,R15 JLT ENDIF6 S R15,R1 A R4,R2 ENDIF6 A R5,R3 BL @DRAWDOT DEC R0 JNE REPEAT2 B *R7 ;---------- ; ; Register usage (SCRWS) ; ; R0 VDP Addr ; R1 VDP R/W ; R2 ; R3 Bit mask ; R4 Byte offset in tables ; R5 Bit offset in byte ; R6 ; R7 Branch address ; R8 Temp ; R9 ; R10 ; R11 ; R12 ; R13 Old WP ; R14 Old PC ; R15 Old ST (used to return different conditions) ; DRAWWS .BLOCK 32 SCRWS .BLOCK 32 SETSCREEN: .WORD SCRWS,SETPGM GETSCREEN: .WORD SCRWS,GETPGM SETPGM BL @CHECK ;Range check coordinates BL @CALCOFFS ;Convert to address MOV @16(R13),R7 ;Fetch mode from R8 MOV @JMPTBLE2(R7),R7 B *R7 JMPTBLE2 .WORD ACTL1,ACTION1,ACTION1,ACTION3,ACTION4 .WORD ACTL1,ACTION6,ACTION7,ACTION8,ACTL1 CARRYMASK .WORD 1000H CHECK SOC @CARRYMASK,R15 ;Prepare return with carry LI R1,191 ;Fetch x,y and invert y S @6(R13),R1 MOV @4(R13),R0 C R0,@XMIN ;Range check with global JL ACTL1 C R0,@XMAX JH ACTL1 C R1,@YMIN JL ACTL1 C R1,@YMAX JH ACTL1 SZC @CARRYMASK,R15 ;No carry if within range B *R11 CALCOFFS MOV R1,R4 ;Convert x,y coord. to bit and byte offset SLA R4,5 ;From the E/A manual SOC R1,R4 ANDI R4,0FF07H MOV R0,R5 ANDI R5,7 A R0,R4 ;Byte offset S R5,R4 ;Bit offset AI R4,PATTERN2 ;Read the byte MOV R4,R0 BLWP @VSBR LI R3,8000H ;Make a bit mask MOV R5,R0 SRC R3,0 B *R11 ; Underwrite action ACTION3 MOVB R1,R1 ;Some bit set in this color group? JNE ACTION6 ;If so, just set this bit too ; Otherwise, continue as with an overwrite ; Substitute and overwrite actions ACTION1 SOCB R3,R1 ;Set bit MOV R4,R0 BLWP @VSBW AI R0,-PATTERN2 ;Offset in color table, which starts @0000 BLWP @VSBR ;Color byte ANDI R1,0F00H ;Keep background MOV @20(R13),R7 ;Fetch new color SRC R7,4 ;Place in leftmost nibble SOCB R7,R1 BLWP @VSBW ACTL1 RTWP ; Complement foreground if something is there already ACTION4 MOVB R1,R9 ;Save previous bit pattern SOCB R3,R1 ;Set bit now MOV R4,R0 BLWP @VSBW MOVB R9,R9 ;Check previous pattern JEQ ACTL3 ;No bit set? AI R0,-PATTERN2 ;Offset in color table BLWP @VSBR MOVB R1,@SCRWS+17 ;To R8, lsby ANDI R1,0F00H ;Keep background ANDI R8,0F0H ;Keep foreground SRL R8,4 ;Byte index MOVB @COMPL(R8),R8 ;Get complement color SLA R8,4 SOCB R8,R1 ;Merge color codes together BLWP @VSBW ;Reload ACTL3 RTWP ; Table with complementary colors COMPL .BYTE 14,15,8,6,11,10,3,13,2,12,5,4,9,7,0,1 ; Monochrome functions (performed without changing the color table) ; Draw ACTION6 SOCB R3,R1 ;Set bit ACTL5 MOV R4,R0 BLWP @VSBW RTWP ; Erase ACTION7 SZCB R3,R1 JMP ACTL5 ; Invert ACTION8 XOR R3,R1 JMP ACTL5 EQUMASK .WORD 2000H GETPGM SZC @EQUMASK,R15 BL @CHECK ;Get coord. BL @CALCOFFS ;Convert it CZC R3,R1 ;See if bit is set JEQ BITZERO SOC @EQUMASK,R15 BITZERO RTWP ;----------------------------- ; ; procedure convertline(row :integer; var buffer :packed array[0..255] of char); ; Converts one screen row from internal representation to Epson-compatible ; graphics. ; .PROC CONVERTLINE,2 .REF VSBR,VMBR,DRAWWS MOV *SP+,@DRAWWS+14 ;Buffer pointer MOV *SP+,@DRAWWS+12 ;Screen row LWPI DRAWWS MOV R6,R5 ;Calculate start of row in screen image SLA R6,5 AI R6,IMAGE2 SRA R5,3 ;Start of correct part of pattern table SLA R5,11 AI R5,PATTERN2 LI R3,32 ;Number of bytes on a screen row LOOP3 MOV R6,R0 ;Read one byte from screen image INC R6 CLR R1 BLWP @VSBR SRL R1,5 ;Calculate address in pattern table MOV R1,R0 A R5,R0 LI R1,SOURCE ;Fetch 8 byte definition LI R2,8 BLWP @VMBR LWPI PASCALWS ;Transpose the graphics LI R1,DEST CLR *R1 ;Clear destination buffer CLR @DEST+2 CLR @DEST+4 CLR @DEST+6 LI R6,8 LI R3,7FFFH ;Source mask LOOP2 LI R0,SOURCE LI R4,8000H ;Destination mask LI R5,8 ;8 bytes to convert LOOP1 MOVB *R0+,R2 SZCB R3,R2 ;Clear all but interesting bit JEQ BLANK SOCB R4,*R1 BLANK SRL R4,1 ;Change destination mask DEC R5 JNE LOOP1 ;Check next source byte SRC R3,1 ;Next bit in source INC R1 DEC R6 JNE LOOP2 LWPI DRAWWS LI R10,8 LI R12,DEST OUTLOOP MOVB *R12+,*R7+ DEC R10 JNE OUTLOOP DEC R3 ;Next byte in row JNE LOOP3 LWPI PASCALWS B *R11 SOURCE .BLOCK 8 ;Internal graphics buffer DEST .BLOCK 8 ;Printer graphics buffer .END Created at Oct 2, Tue, 22:36.20 TURTLE:BITUASM.1.TEXT ;-------- ; ; procedure bitmap(var buffer :sometype, 1000 bytes large); ; .PROC BITMAP,1 .DEF VMBR,VMBW,VSBW,VSBR,VWTR,VFILL .DEF INITSTUFF LI R0,KEYBUF1 ;Move keyboard buffer MOV *SP+,R1 ;Get address of general buffer LI R2,20H ;Size of buffer BLWP @VMBR LI R0,KEYBUF2 BLWP @VMBW MOV R0,@KEYBUFPNT LI R0,LAYOUT1 ;Move layout area LI R2,120 ;Size of area BLWP @VMBR LI R0,LAYOUT2 BLWP @VMBW MOV R0,@LAYOUTPNT LI R0,81A0H ;Blank screen BLWP @VWTR LI R0,8002H ;Set control registers for bit map mode BLWP @VWTR ;No PME copy of VDP R0 LI R0,8206H BLWP @VWTR MOV R0,@REGCOPY+2 ;Update PME copies of VDP regs LI R0,837FH BLWP @VWTR MOV R0,@REGCOPY+4 LI R0,8407H BLWP @VWTR MOV R0,@REGCOPY+6 LI R0,8536H BLWP @VWTR MOV R0,@REGCOPY+8 LI R0,PATTERN1 ;Save first 24 bytes of pattern table LI R2,24 ;Corresponds to chr(0)..chr(2) BLWP @VMBR LI R0,SAVE2B BLWP @VMBW LI R0,PATTERN1+24 ;Save next 1000 bytes LI R2,1000 ;Corresponds to chr(3)..chr(127) BLWP @VMBR ;chr(128)..chr(255) not saved LI R0,SAVE2A BLWP @VMBW LI R0,SAB2 ;Disable first sprite LI R1,0D000H BLWP @VSBW ; This is an entry point for initbitmap. ; INITSTUFF: LI R0,COLTAB2 ;Set color table to black on transparent LI R1,1000H LI R2,1800H BLWP @VFILL LI R0,IMAGE2 .OR 4000H ;Initiate screen image table SWPB R0 MOVB R0,@VDPWA SWPB R0 MOVB R0,@VDPWA LI R0,3 ;00..FF repeated three times LOOP2 CLR R1 LI R2,100H ;Counter LOOP1 MOVB R1,@VDPWD AI R1,100H DEC R2 JNE LOOP1 DEC R0 JNE LOOP2 LI R0,PATTERN2 ;Set pattern table to all blank CLR R1 LI R2,1800H BLWP @VFILL LI R0,81E0H ;Enable screen in graphics mode BLWP @VWTR MOV R0,@REGCOPY B *R11 ;-------------------------------------------- VIDEO UTILITIES --------- VDPWS .BLOCK 20H ;Workspace for VDP routines R2LB .EQU VDPWS+5 ;Address of lsby R2 VSBW .WORD VDPWS,VSBWPGM VMBW .WORD VDPWS,VMBWPGM VSBR .WORD VDPWS,VSBRPGM VMBR .WORD VDPWS,VMBRPGM VWTR .WORD VDPWS,VWTRPGM VFILL .WORD VDPWS,VFILLPGM ;VDP fill VFILLPGM BL @WVDPWA FILLOOP MOVB R1,@VDPWD DEC R2 JNE FILLOOP RTWP ;VDP write to register VWTRPGM MOV *R13,R0 MOVB @VDPWS+1,@VDPWA ORI R0,8000H MOVB R0,@VDPWA RTWP ; VDP single byte write VSBWPGM BL @WVDPWA ;Write out address MOVB @2(R13),@VDPWD ;Write data RTWP ; VDP multiple byte write VMBWPGM BL @WVDPWA ;Write out address VWTMORE MOVB *R1+,@VDPWD DEC R2 ;Byte count JNE VWTMORE RTWP ; VDP single byte read VSBRPGM BL @WVDPRA ;Write out address MOVB @VDPRD,@2(R13) ;Read data RTWP ; VDP multiple byte read VMBRPGM BL @WVDPRA ;Write out address VRDMORE MOVB @VDPRD,*R1+ ;Read a byte DEC R2 JNE VRDMORE RTWP ;Sets up VDP addresses WVDPWA LI R1,4000H ;Indicates write JMP WVDPAD WVDPRA CLR R1 ;Indicates read address WVDPAD MOV *R13,R2 ;Get VDP address MOVB @R2LB,@VDPWA ;Write low byte SOC R1,R2 ;Set read/write bit MOVB R2,@VDPWA ;Write high byte MOV @2(R13),R1 ;Get CPU RAM address MOV @4(R13),R2 ;Get byte count B *R11 ;-------------------- ; ; procedure nobitmap(var buffer: sometype, 1000 bytes large); ; .PROC NOBITMAP,1 .REF VMBR,VMBW,VSBW,VWTR,VFILL LI R0,KEYBUF2 ;Restore keyboard buffer MOV *SP+,R1 ;Buffer LI R2,32 BLWP @VMBR LI R0,KEYBUF1 BLWP @VMBW MOV R0,@KEYBUFPNT LI R0,LAYOUT2 ;Restore keyboard layout area LI R2,120 BLWP @VMBR LI R0,LAYOUT1 BLWP @VMBW MOV R0,@LAYOUTPNT LI R0,81A0H ;Disable screen during manipulations BLWP @VWTR CLR R0 BLWP @VWTR ;No bit-map LI R0,8202H BLWP @VWTR MOV R0,@REGCOPY+2 ;PME copies of VDP regs LI R0,832FH BLWP @VWTR MOV R0,@REGCOPY+4 LI R0,8400H BLWP @VWTR MOV R0,@REGCOPY+6 LI R0,8518H BLWP @VWTR MOV R0,@REGCOPY+8 LI R0,8717H BLWP @VWTR MOV R0,@REGCOPY+12 LI R0,SAVE2B ;Restore character definitions LI R2,24 ;chr(128)..chr(255) are blanked BLWP @VMBR LI R0,PATTERN1 BLWP @VMBW LI R0,SAVE2A LI R2,1000 BLWP @VMBR LI R0,PATTERN1+24 BLWP @VMBW LI R0,PATTERN1+1024 CLR R1 ;Blank unsaved definitions MOV R0,R1 BLWP @VFILL LI R0,COLTAB1 ;Set color to black/transp. LI R1,1000H LI R2,32 BLWP @VFILL LI R0,SAB1 ;Disable first sprite LI R1,0D000H BLWP @VSBW MOV R11,R7 BL @47D2H ;Put back previous text on screen LI R0,40 MOV R0,@2CC6H ;Set screen width for text mode LI R0,81F0H ;Set VDP to text mode BLWP @VWTR MOV R0,@REGCOPY B *R7 ;-------------------------- ; ; procedure initbitmap; ; ; Clears the graphics screen without returning to text mode. ; Also resets the color table. ; .PROC INITBITMAP .REF INITSTUFF,VWTR MOV R11,R7 LI R0,81A0H ;Blank screen BLWP @VWTR LI R0,8717H ;Color to black on cyan BLWP @VWTR MOV R0,@REGCOPY+12 BL @INITSTUFF B *R7 Created at Oct 2, Tue, 22:37.23 TURTLE:TURTLIB.TEXT turtle:turtleunit Created at Oct 2, Tue, 22:37.28 TURTLE:TURTMANUAL.TEXT TURTLE GRAPHICS History A graphics package, called Turtle Graphics, has been part of the UCSD p- System from its earliest stages. The implementation for the TI 99/4A, however, lacks this package. This is of course due to the fact that this p- system was developed for the 99/4, which didn't have any bit-map mode. But the 4A has, and hence the hardware doesn't prevent graphics. But one problem remained. The 99/4A uses VDP RAM as an alternate code pool, not giving enough space for the extensive memory requirements imposed by the bit- map mode. Unfortunately the TI system was delivered without the kernel unit, and therefore prevents easy access to system resources. Now this problem has been circumvented. After figuring out where the system has some pointers used for memory management, conversion to bit- map mode turned out to be possible, without endangering the p-system execution environment. Memory reservation When an application that uses turtle graphics is loaded, the graphics package attempts to reserve the required VDP RAM space before the main program starts. But if the application is large, this might be impossible, since the required memory might already be occupied by program code. When this happens, the user is notified, and the program halts. The solution is to reserve the memory prior to loading the application. A special utility, called BITRESERVE, is provided to perform this. BITRESERVE allows allocation and deallocation of bit-map memory, as well as showing the amount of VDP RAM available. Another solution, which doesn't require any special action every time your program is to be loaded, is to change the code type of your program. If the code type of your program is M_9900, rather than M_PSEUDO, that program will be loaded in the alternate code pool (32 K RAM bank) from the beginning. Thus it will not intrude on the VDP RAM required for bit map mode. Introduction The graphics package is reached by including the statement 'uses turtlegraphics' in your program. The routines then provided are more or less a copy of the capabilities offered by the same unit for Apple Pascal II.1. Some parts are influenced by the unit usually accompanying the UCSD p-system version IV. Finally, some changes has been imposed by the somewhat restricted color resolution provided by the TMS 9918A/9929. General The screen is considered a rectangle, 256 pixels wide and 192 pixels high. Each pixel is reached with its coordinate, with (0,0) being in the lower left and (255,191) in the upper right corner. By default, the background color is transparent, which allows the standard p-system backdrop color (cyan) to show through. The foreground color is black. Grafmode The procedure grafmode enables the graphics mode. The defaults are loaded, and the screen is erased. Textmode By calling textmode, the system returns to the default screen, giving 24*40 characters at a time. The text shown on the screen when grafmode was called is restored, although the definitions of the characters 128..255 are erased. NOTE! Calling textmode twice, without any grafmode in between, leaves the system in an indeterminate state. The same is valid for the opposite combination. Initturtle When already in graphics mode, i.e. after calling grafmode once, initturtle clears the screen and sets the defaults, without returning to text mode. Initturtle may be called any number of times. Viewport All screen activities are constricted to the viewport concept. The viewport is the active part of the screen. By calling viewport, you may limit the actions caused by drawing lines etc. to the active rectangle. The proper argument sequence is viewport(left,right,bottom,top). The viewport defaults to the entire screen (0,255,0,191). Pen color Calling pen_color sets the desired color. The type screen_color is accessible to the application. It contains the colors allowed. They are: transparent, black, green2, green3, blue1, blue3, red1, cyan, red2, red3, yellow1, yellow3, green1, magenta, gray and white. Where numbers are used to designate different shades of the same color, one (1) is used for the darkest shade etc. Pen mode Although the color used is set by pen_color, pen_mode determines if drawing is done at all. There are nine modes, but some gives the same effect. INVISIBLE: No drawing occurs. SUBSTITUTE: Drawing occurs. The foreground color is changed to the active color. OVERWRITE: Same as substitute. Included only for compatibility reasons. UNDERWRITE: Drawing occurs. The color is changed only if the pixel wasn't occupied previously. COMPLEMENT: If the pixel isn't set already, set it. Then use the background color, complement it, and reinsert it as the new foreground color. If the pixel is set already, just complement the foreground color. NONE: Same as invisible. DRAW: Drawing occurs. No change of color. ERASE: Erases eventually set pixels. Doesn't change the color. REVERSE: Inverts the pixels. Doesn't change the color. Since the modes none, draw, erase and reverse doesn't affect the colors, they are faster than their colored counterparts. Move Moves the turtle the specified distance in the current direction. Leaves a trail, being the straightest possible line, on the screen, if pen_mode is set to something that enables drawing, and the turtle moves in the current viewport. If the turtle starts and/or stops outside the viewport, but passes it on the way, only the part of the trail that is inside the viewport is drawn. The default position of the turtle is in the middle of the screen (128,96), heading to the right (0 degrees). Moveto Same as move, but moves to a specified coordinate. Turn Turns the turtle the specified angle. Only integer angles are used, one revolution comprising 360 degrees. Positive angles results in turns to the left or counter-clockwise. Turnto Same as turn, but turns directly to the specified angle. 0 is to the right, 90 upwards, 180 to the left, 270 downwards and so on. Negative angles are also allowed, with -90 degrees giving the same result as 270 degrees, etc. Turtle x, turtle y and turtle ang By calling the functions turtle_x, turtle_y and turtle_ang, the current position and heading of the turtle can be determined. W_char Writes one character on the screen. The character is placed with its lower left corner at the current turtle position. The position is then incremented by six, which is the character width in text mode. The character definitions are the same as used before calling grafmode. NOTE! If you want to change the appearence of some character by using set_pattern in the support unit, this must be done prior to calling grafmode. Calling any routine in the support unit, except set_chr_color and joy, gives incorrect results and/or leaves the system in an indeterminate state. NOTE! Only character codes 0..127 are available when the graphics mode is active. Attempts to place a character outside the current viewport gives no visible result, but the current position is still incremented. This is also true even if it gets outside the physical screen. W_char doesn't adhere to the current pen_color or pen_mode, at least not yet. Writing always takes place, using the current foreground and background colors. W_string Same as w_char, but writes an entire string. No scrolling is done, in any direction. Hardcopy Copies the screen, without color information, to the printer. The output is adapted to single density resolution for Epson-compatible printers. Additional information When colors are complemented, the following scheme is used. Transparent -> Gray Black -> White M Green -> M Red L Green -> D Red D Blue -> L Yellow L Blue -> D Yellow D Red -> L Green Cyan -> Magenta M Red -> M Green L Red -> D Green D Yellow -> L Blue L Yellow -> D Blue D Green -> L Red Magenta -> Cyan Gray -> Transparent White -> Black Since the graphics mode introduces a turmoil in VDP RAM, all screen related normal procedures will fail to behave properly. Keyboard input with read is impossible, as well as screen output with write. In the former case, use bufscan in the extrascreen unit. In the latter, use w_string. This movement of tables also disables the proper function of the screen left and screen right function keys. NOTE! These keys are not made inactive, but their use will usually corrupt the color table used for graphics. Created at Oct 2, Tue, 22:38.51 TURTLE:TURTLEUPAS.TEXT unit turtlegraphics; (* Test of turtle graphic routines *) (* A-DATA 870408 *) interface type screen_color = (transparent,black,green2,green3,blue1,blue3,red1,cyan,red2, red3,yellow1,yellow3,green1,magenta,gray,white); screen_mode = (invisible,substitute,overwrite,underwrite,complement, none,draw,erase,reverse); procedure grafmode; procedure initturtle; procedure textmode; procedure viewport(left,right,bottom,top:integer); procedure pen_color(newcolor :screen_color); procedure pen_mode(newmode :screen_mode); procedure move(distance :integer); procedure moveto(x,y :integer); procedure turn(newangle :integer); procedure turnto(newangle :integer); function turtle_x :integer; function turtle_y :integer; function turtle_ang :integer; procedure w_char(ch :char); procedure w_string(line :string); procedure hardcopy; implementation const intmem = 10112; (* Interpreters VDP memory pointer *) topmem = 10114; (* Top VDP memory pointer *) newint = 14360; (* New intmem value *) stdint = 3576; (* Standard intmem value *) type dual = record case boolean of true :(int :integer); false:(ptr :^integer); end; (* dual *) var xmin, (* Viewport limits *) xmax, ymin, ymax, currx, (* Current location *) curry, angle :integer; color :screen_color; (* Current modes *) mode :screen_mode; reserved :boolean; procedure poke(addr,value :integer); var window :dual; begin window.int := addr; window.ptr^ := value; end; (* poke *) function peek(addr :integer):integer; var window :dual; begin window.int := addr; peek := window.ptr^; end; (* peek *) procedure bitmap(var buffer); external; (* Activates bit-map mode *) procedure nobitmap(var buffer); external; (* Deactivates bit-map mode *) procedure initbitmap; external; (* Clears bit-map when already active *) procedure drawline(var range:integer; xstart,ystart,deltax,deltay:integer; ink:screen_color; mode :screen_mode); external; (* Draws a line between two points *) procedure convertline(row :integer; var buffer); external; (* Converts one screen row to Epson-codes *) procedure fastdelta(distance :integer; var deltax,deltay :integer); external; (* Calculates x and y composants of distance to move *) procedure writechar(row,col :integer; ch :char); external; (* Writes one character at the current location *) procedure viewport; begin xmin := left; xmax := right; ymin := bottom; ymax := top; end; (* viewport *) procedure commoninit; (* Initiation common to both grafmode and initturtle *) begin viewport(0,255,0,191); currx := 128; curry := 96; (* Turtle in screen center *) angle := 0; color := black; mode := invisible; end; (* commoninit *) procedure grafmode; var buffer :array[0..499] of integer; (* Size 1000 bytes *) begin commoninit; bitmap(buffer); end; (* grafmode *) procedure initturtle; (* Clears the screen and the color table, once in bit-map mode *) begin commoninit; initbitmap; end; (* initturtle *) procedure textmode; var buffer :array[0..499] of integer; begin nobitmap(buffer); end; (* textmode *) procedure pen_color; begin color := newcolor; end; (* pencolor *) procedure pen_mode; begin mode := newmode; end; (* pen_mode *) procedure moveto; var temp :integer; begin drawline(temp,currx,curry,x-currx,y-curry,color,mode); currx := x; curry := y; end; (* moveto *) procedure turnto; begin angle := newangle; end; (* turnto *) procedure turn; begin angle := angle+newangle; end; (* turn *) procedure move; var temp, deltax, deltay :integer; begin fastdelta(distance,deltax,deltay); (* Fast sine and cosine *) drawline(temp,currx,curry,deltax,deltay,color,mode); currx := currx+deltax; curry := curry+deltay; end; (* move *) function turtle_ang; (* Returns the current angle *) begin turtle_ang := angle; end; (* turtle ang *) function turtle_x; (* Returns the current x position *) begin turtle_x := curr_x; end; (* turtle x *) function turtle_y; (* Returns the current y position *) begin turtle_y := curr_y; end; (* turtle y *) procedure w_char; (* Places one character on the screen *) begin (* Placement is restricted to the viewport *) if (curry=ymin) and (currxxmin) then writechar(curry,currx,ch); currx := currx+6; end; (* w_char *) procedure w_string; (* Writes a string on the screen *) var i :integer; begin (* w_string *) for i := 1 to length(line) do w_char(line[i]); end; (* w_string *) procedure hardcopy; (* Copies the screen on an Epson-compatible printer *) var buffer: packed array[0..255] of char; codebuffer: packed array[0..3] of char; crlf : packed array[0..1] of char; row: integer; begin (* Set up codebuffer with codes for graphics *) codebuffer[0] := chr(27); codebuffer[1] := 'A'; codebuffer[2] := chr(8); unitwrite(6,codebuffer,3); (* Set 8/72" LF *) codebuffer[1] := 'K'; (* Codes for single density graphics *) codebuffer[2] := chr(0); codebuffer[3] := chr(1); crlf[0] := chr(13); crlf[1] := chr(10); (* The trailing control argument to unitwrite removes the special character handling, which otherwise corrupts the graphic data. *) for row := 0 to 23 do begin unitwrite(6,codebuffer,4,,12); (* Codes for graphic *) convertline(row,buffer); (* Get graphic data *) unitwrite(6,buffer,256,,12); (* Graphic data *) unitwrite(6,crlf,2,,12); (* CR and LF *) end; codebuffer[1] := '2'; unitwrite(6,codebuffer,2,,12); (* Reset 1/6" LF *) end; (* hardcopy *) begin (* main *) (* Check if VDP RAM is reserved for bit-map. If not, try to do it *) reserved := false; if peek(intmem)newint then begin poke(intmem,newint); reserved := true; end else begin writeln('VDP RAM space not reserved for graphics'); writeln('Reservation on the fly impossible'); exit(program); end; end; ***; (* Give back VDP RAM if reserved by this unit *) if reserved then poke(intmem,stdint); end. Created at Oct 2, Tue, 22:39.57 TURTLE:TURTLEUASM.TEXT .PAGEHEIGHT 65 .TITLE "Support for unit turtlegraphics" PASCALWS .EQU 8380H SP .EQU 10 ;----------------------- ; ; procedure fastdelta(distance :integer; var deltax,deltay :integer); external; ; ; Calculates the x and y composants of a distance with the current angle. ; ; A-DATA 861126 ; ;--------- ; ; Register usage (PASCALWS) ; ; R0 sine-cosine flag ; R1 For divide and multiply ; R2 For divide and multiply ; R3 Third return link ; R4 Distance copy ; R5 Negation flag ; R6 Argument pointer ; R7 Second return link ; R8..R15 PME ; .PROC FASTDELTA,3 .PUBLIC ANGLE DELTAY .EQU 0 ;Stack offsets for arguments DELTAX .EQU 2 DIST .EQU 4 MOV R11,R7 ;Save return link MOV @DELTAY(SP),R6 CLR R0 ;Offset in routine address table SETO R5 ;Negation on MOV @ANGLE,R2 JLT ISNEG ;Must remember sign of angle for y value, since CLR R5 ;sine is an odd function. ISNEG BL @CALC ;Loads DELTAY with the correct value MOV @DELTAX(SP),R6 INC R0 ;Increment offset for cosine calculation CLR R5 ;No negation MOV @ANGLE,R2 ;Sign of angle uninteresting for cosine BL @CALC ;Loads DELTAX with proper value AI SP,6 ;Adjust SP B *R7 ;Return to Pascal D90 .WORD 90 ;Used for angle reduction CALC ;Calculates motion composant MOV R11,R3 ABS R2 ;Angle CLR R1 DIV @D90,R1 ANDI R1,3 ;Keep a quotient in the 0..3 range A R0,R1 ;Offset for sine-cosine selection SLA R1,1 MOV @SINVAL(R1),R1 ;Fetch address of proper routine BL *R1 MOV @DIST(SP),R4 JGT DISTNEG ;Check sign of distance for backward movement INV R5 DISTNEG ABS R4 ;For multiply MPY R4,R1 ;Multiply distance by composant DIV @D10000,R1 ;Rescale CI R2,5000 ;Rounding JL HOLD INC R1 ;Round up HOLD MOV R5,R5 ;Check for sign JEQ NONEG NEG R1 NONEG MOV R1,*R6 ;Load argument B *R3 ; Routines which calculates the function value for different quarters of the ; circle. SINVAL .WORD SIN0 COSVAL .WORD SIN1,SIN2,SIN3,SIN0 SIN0 SLA R2,1 ;sin(0..89) and cos(270..359) MOV @SINTABLE(R2),R1 B *R11 SIN1 MOV @D90,R1 ;sin(90..179) and cos(0..89) S R2,R1 SLA R1,1 MOV @SINTABLE(R1),R1 B *R11 SIN2 SLA R2,1 ;sin(180..269) and cos(90..179) MOV @SINTABLE(R2),R1 INV R5 B *R11 SIN3 MOV @D90,R1 ;sin(270..359) and cos(180..269) S R2,R1 SLA R1,1 MOV @SINTABLE(R1),R1 INV R5 B *R11 ; Table of sine values for arguments between 0 and 90 degrees. ; All values multiplied by 10000. SINTABLE .WORD 0, 175, 349, 523, 698 ;Sine of [0..4] .WORD 872, 1045, 1219, 1392, 1564 ;Sine of [5..9] .WORD 1736, 1908, 2079, 2250, 2419 ;Sine of [10..14] .WORD 2588, 2756, 2924, 3090, 3256 ;Sine of [15..19] .WORD 3420, 3584, 3746, 3907, 4067 ;Sine of [20..24] .WORD 4226, 4384, 4540, 4695, 4848 ;Sine of [25..29] .WORD 5000, 5150, 5299, 5446, 5592 ;Sine of [30..34] .WORD 5736, 5878, 6018, 6157, 6293 ;Sine of [35..39] .WORD 6428, 6561, 6691, 6820, 6947 ;Sine of [40..44] .WORD 7071, 7193, 7314, 7431, 7547 ;Sine of [45..49] .WORD 7660, 7771, 7880, 7986, 8090 ;Sine of [50..54] .WORD 8192, 8290, 8387, 8480, 8572 ;Sine of [55..59] .WORD 8660, 8746, 8829, 8910, 8988 ;Sine of [60..64] .WORD 9063, 9135, 9205, 9272, 9336 ;Sine of [65..69] .WORD 9397, 9455, 9511, 9563, 9613 ;Sine of [70..74] .WORD 9659, 9703, 9744, 9781, 9816 ;Sine of [75..79] .WORD 9848, 9877, 9903, 9925, 9945 ;Sine of [80..84] .WORD 9962, 9976, 9986, 9994, 9998 ;Sine of [85..89] D10000 .WORD 10000 ;Sine of 90 .PROC WRITECHAR,3 ;----------------------------------- ; ; procedure writechar(row,col :integer; ch :char); ; ; Writes a character at the current character write location. ; ; A-DATA 870407 ;------------- ; ; Register usage (DRAWWS) ; ; R0 Arguments (code) ; R1 Arguments ; R2 Arguments ; R3 Mask ; R4 Offset ; R5 Bit # ; R6 Column ; R7 Row ; R8 Counter ; R9 Temp ; R10 Stack pointer ; R11 Return link ; R12 Physical row crossing flag ; R13 ; R14 ; R15 ; .REF VMBR,VMBW,DRAWWS SAVE2A .EQU 1C18H ;Character definition savearea SAVE2B .EQU 3800H PATTERN2 .EQU 2000H LWPI DRAWWS ;Copy SP MOV @PASCALWS+20,SP BL @CALCCHAR ;Get character definition BL @CALCOFFS ;Calculate address of screen position LI R1,IMAGEBUF BL @SETFETCH ;Set pattern address and fetch pattern LI R3,0FC00H ;Make insert mask for left side MOV R5,R0 ;Bit # SRC R3,0 LI R8,-8 ;Reset byte counter ;Insert left part of the character on screen LOOP1 SZCB R3,@IMAGEBUF+8(R8) ;Clear image at character location MOVB @PATBUF+8(R8),R9 ANDI R9,0FC00H ;Reduce character width to text mode SRC R9,0 ;Place in correct position SOCB R9,@IMAGEBUF+8(R8) INC R8 JNE LOOP1 BL @STORE ;Store left part of character CHKNEXT AI R5,6 ;See if entire character fitted in 8*8 square CI R5,8 JLE PASCAL A @H08,@UPOFFS ;Address of adjacent square A @H08,@LOWOFFS AI R4,8 BL @FETCH ;Fetch it LI R3,0FC00H ;Make insert mask for right part LI R0,14 S R5,R0 SLA R3,0 ; Now insert right part of the character. ; The method used is the same as for the left part above. LI R8,-8 ;Reset byte count LOOP2 SZCB R3,@IMAGEBUF+8(R8) MOVB @PATBUF+8(R8),R9 ANDI R9,0FC00H SLA R9,0 SOCB R9,@IMAGEBUF+8(R8) INC R8 JNE LOOP2 BL @STORE ;Right part PASCAL MOV SP,@PASCALWS+20 ;Restore stack pointer LWPI PASCALWS B *R11 ; Calculates offsets for upper and lower part of the pattern ; Stores the values for further reference SETFETCH COC @H07,R4 ;Check if special, easy case JEQ EASYSET ; Complex case, crossing physical rows SETO R12 ;Case flag MOV R4,R0 ;Address of upper part AI R0,-255 MOV R0,@UPOFFS LI R2,7 ;Number of bytes in upper part MOV R4,R9 ANDI R9,7 S R9,R2 MOV R2,@UPCOUNT BLWP @VMBR ;Read upper part A R2,R1 ;Adjust buffer pointer MOV R4,R0 ;Start address of lower part ANDI R0,0FFF8H MOV R0,@LOWOFFS MOV R9,R2 ;Number of bytes in lower part INC R2 MOV R2,@LOWCOUNT BLWP @VMBR ;Read lower part B *R11 EASYSET CLR R12 ;Case flag AI R4,-7 ;Address of top of character MOV R4,R0 BLWP @VMBR ;Read entire character B *R11 ; Returns IMAGEBUF to color or pattern table STORE MOV R12,R12 JEQ EASYW MOV @UPOFFS,R0 LI R1,IMAGEBUF MOV @UPCOUNT,R2 BLWP @VMBW A R2,R1 MOV @LOWOFFS,R0 MOV @LOWCOUNT,R2 BLWP @VMBW B *R11 EASYW MOV R4,R0 BLWP @VMBW B *R11 ; Fetches color or pattern data to IMAGEBUF FETCH MOV R12,R12 JEQ EASYR MOV @UPOFFS,R0 LI R1,IMAGEBUF MOV @UPCOUNT,R2 BLWP @VMBR A R2,R1 MOV @LOWOFFS,R0 MOV @LOWCOUNT,R2 BLWP @VMBR B *R11 EASYR MOV R4,R0 BLWP @VMBR B *R11 ; Fetches character definition to PATBUF ; Definition is at code*8+SAVE2B if code<=2. ; Else, the address is code*8+SAVE2A-24 CALCCHAR MOV *SP+,R0 ;Code # SLA R0,3 ;Calculate address of definition LI R2,SAVE2A-24 CI R0,2*8 JH BIGCODE LI R2,SAVE2B BIGCODE A R2,R0 LI R1,PATBUF ;Load pattern into PATBUF LI R2,8 BLWP @VMBR B *R11 ; Fetch row and column. Calculate offset and bit # CALCOFFS MOV *SP+,R6 ;Column LI R7,191 ;Row S *SP+,R7 ;Invert row MOV R7,R4 ;Calculate offset and bit # SLA R4,5 SOC R7,R4 ANDI R4,0FF07H MOV R6,R5 ANDI R5,7 A R6,R4 S R5,R4 AI R4,PATTERN2 ;Start of pattern table B *R11 PATBUF .BLOCK 8 IMAGEBUF .BLOCK 8 H07 .WORD 7 H08 .WORD 8 UPOFFS .WORD UPCOUNT .WORD LOWOFFS .WORD LOWCOUNT .WORD .END Created at Oct 2, Tue, 22:41.26 TURTLE:TURTTEST1.TEXT program turtletest; uses extrascreen, (*$U turtleunit.code *) turtlegraphics; var length, angle, depth :integer; procedure new_tree(length,angle,depth :integer); procedure back(length :integer); begin pen_mode(none); move(-length); pen_mode(draw); end; (* back *) begin (* new_tree *) if depth>0 then begin turn(angle); move(2*length); newtree(length,angle,depth-1); back(2*length); turn(-2*angle); move(length); new_tree(length,angle,depth-1); back(length); turn(angle); end; end; (* new_tree *) begin repeat writeln('Enter length, angle and depth'); writeln('Use 0 0 0 to stop'); readln(length,angle,depth); grafmode; moveto(150,0); turnto(90); pen_mode(draw); new_tree(length,angle,depth); while bufscan=-1 do; textmode; until (length=0) and (angle=0) and (depth=0); end. Created at Oct 2, Tue, 22:41.39 TURTLE:TURTTEST2.TEXT program turttest; uses (*$U turtleunit.code *) turtlegraphics; var i :integer; begin grafmode; pen_mode(draw); turn(25); for i := 1 to 4 do begin move(40); turn(90); end; for i := 1 to 1000 do; textmode; end. Created at Oct 2, Tue, 22:41.45 TURTLE:TURTTEST3.TEXT program turttest3; uses support, (*$U turtleunit.code *) turtlegraphics; var x, y :integer; procedure run(angle,dist :integer); begin turnto(angle); move(dist); end; (* run *) begin grafmode; pen_mode(draw); while not joy(0,x,y) do begin case x+3*y of -4: run(225,1); -3: run(270,1); -2: run(315,1); -1: run(180,1); 1: run(0,1); 2: run(135,1); 3: run(90,1); 4: run(45,1); end; (* case *) end; (* while *) hardcopy; textmode; end. Created at Oct 2, Tue, 22:41.55 TURTLE:TURTTEST4.TEXT program turttest; (* Test of cooperation between turtlegraphics and the analog joystick box connected to the I/O-card *) (* A-DATA 870206 *) uses analogbox, (*$U turtleunit.code *) turtlegraphics; var count, mode, keycode, i, x, y :integer; line :string; first_press :boolean; procedure alloff; (* Turns everything on the joystick off *) var i :integer; begin for i := 0 to 2 do lights(i,15); lights(3,0); end; (* alloff *) begin (* Main program *) (* Turn off all light when writing on the screen *) alloff; writeln('Simple turtlegraphics test.'); writeln('This program is joystick controlled.'); writeln; writeln('The display indicates the mode.'); writeln('0: Erasing.'); writeln('1: Drawing.'); writeln('2: Reversing.'); writeln; writeln('Press the middle key to change mode.'); writeln; writeln('Press the key with the light to stop'); writeln('with a printout.'); writeln('Press the unlit key to just stop.'); writeln; writeln('Press any joystick key to start.'); (* Flash the LEDs alternatively while waiting *) count := 0; mode := 0; lights(3,2); while keys=0 do begin count := (count+1) mod 100; if count=0 then begin mode := 1-mode; lights(3,2-mode); end; end; (* while *) lights(3,0); repeat grafmode; (* Set the starting point at current joystick position, without drawing *) pen_mode(none); analog(x,y); moveto(x,y*3 div 4); pen_mode(draw); lights(1,1); (* Set middle digit to '1' *) lights(3,2); (* Turn left LED on *) mode := 1; (* If the middle key was used to initiate graphics, the drawing mode will change immediately if we don't inform it about that it's not a new key. *) first_press := false; repeat (* Draw a line to the new joystick position *) analog(x,y); moveto(x,y*3 div 4); (* See if change of mode is desired *) keycode := keys; if (keycode=2) and first_press then begin mode := (mode+1) mod 3; first_press := false; end; if keycode=0 then first_press := true; case mode of 1: pen_mode(draw); 2: pen_mode(reverse); 0: pen_mode(erase); end; (* case *) lights(1,mode); (* We don't want to quit immediately either. *) until first_press and (keycode in [1,4]); alloff; (* Print if stopped with the left key *) if keycode=4 then hardcopy; while keys<>0 do; (* Make sure the key is released *) textmode; gotoxy(0,20); writeln('Press the lit key to restart.'); writeln('Press any other key to stop.'); lights(3,2); (* Left key means continue *) while keys=0 do; (* Wait for some key *) until keys<>4; alloff; end. (* turttest *) Created at Oct 2, Tue, 22:42.25 TURTLE:TURTTEST5.TEXT program turttest5; (* A-DATA 861125 *) (* From Mikrodatorn 5/82 *) uses extrascreen, random, analogbox, (*$U turtleunit.code *) turtlegraphics; procedure createpicture; var code, a,b,x,y,i,j :integer; procedure color(i :integer); begin case i of 0 :pen_mode(erase); 1 :pen_mode(draw); end; (* case *) end; (* color *) begin (* create picture *) analog(a,b); b := b*3 div 4; randomize; j := 1+rnd_int(4); grafmode; x := 0; while x<256 do begin for i := 0 to 1 do begin pen_mode(none); moveto(x+i,0); color(i); moveto(a,b); moveto(255-x-i,191); end; x := x+j; end; (* while *) y := 0; while y<192 do begin for i := 0 to 1 do begin pen_mode(none); moveto(255,y+i); color(i); moveto(a,b); moveto(0,191-y-i); end; (* for *) y := y+j; end; (* while *) repeat code := bufscan; until code<>-1; if (code=ord('P')) or (code=ord('p')) then hardcopy; textmode; end; (* createpicture *) begin createpicture; end. Created at Oct 2, Tue, 22:42.40 TURTLE:TURTTEST6.TEXT program turttest6; uses extrascreen, (*$U turtleunit.code *) turtlegraphics; type figtype = array[1..8,1..3] of integer; transtype = array[1..3,1..3] of integer; var drawing, figure :figtype; transarr :transtype; procedure makefigure(var figure :figtype); procedure fillrow(var arr :figtype; row,x,y,z :integer); begin arr[row,1] := x; arr[row,2] := y; arr[row,3] := z; end; (* fillrow *) begin fillrow(figure,1,1,3,-2); fillrow(figure,2,-1,-2,-2); fillrow(figure,3,2,-2,-7); fillrow(figure,4,4,3,-7); fillrow(figure,5,1,3,8); fillrow(figure,6,-1,-2,8); fillrow(figure,7,2,-2,3); fillrow(figure,8,4,3,3); end; (* makefigure *) procedure maketrans(var trans :transtype); var row, col, value :integer; begin for row := 1 to 3 do for col := 1 to 3 do begin write('Enter [',row,',',col,']: '); readln(value); trans[row,col] := value; end; (* for *) end; (* maketrans *) procedure drawit(var arr :figtype); var i :integer; begin (* Translate picture *) for i := 1 to 8 do begin arr[i,1] := arr[i,1]+128; arr[i,2] := arr[i,2]+96; end; (* for *) grafmode; moveto(arr[1,1],arr[1,2]); pen_mode(draw); for i := 2 to 4 do moveto(arr[i,1],arr[i,2]); moveto(arr[1,1],arr[1,2]); for i := 5 to 8 do moveto(arr[i,1],arr[i,2]); moveto(arr[4,1],arr[4,2]); while bufscan=-1 do; textmode; end; (* drawit *) procedure multiply(var arr3,arr1 :figtype; var arr2 :transtype); var row, col, accum, i :integer; begin for row := 1 to 8 do for col := 1 to 3 do begin accum := 0; for i := 1 to 3 do accum := accum+arr1[row,i]*arr2[i,col]; arr3[row,col] := accum; end; (* for *) end; (* multiply *) procedure report(var drawing :figtype); var row, col :integer; begin for row := 1 to 8 do begin for col := 1 to 3 do write(drawing[row,col],' '); writeln; end; while bufscan=-1 do; end; (* report *) begin writeln('Enter transposition matrix'); maketrans(transarr); makefigure(figure); multiply(drawing,figure,transarr); report(drawing); drawit(drawing); end. Created at Oct 2, Tue, 22:43.06 TURTLE:TURTTEST7.TEXT program turttest7; (* First test of color drawing *) (* A-DATA 870206 *) uses analogbox, (*$U turtleunit.code *) turtlegraphics; var x, y, keycode :integer; curr_color :screen_color; curr_mode :screen_mode; first_press :boolean; procedure alloff; (* Turns everything on the joystick off *) var i :integer; begin for i := 0 to 2 do lights(i,15); lights(3,4); end; (* alloff *) procedure blink_wait; (* Waits for a key press while blinking with the LEDs *) var count, mode :integer; begin count := 0; mode := 0; lights(3,2); while keys=0 do begin count := (count+1) mod 75; if count=0 then begin mode := 1-mode; lights(3,2-mode); end; end; (* while *) lights(3,4); end; (* blink_wait *) procedure init_text; (* Displays instructions in the beginning *) begin writeln('Turtlegraphics test with color'); writeln('This program is joystick controlled'); writeln; writeln('The left digit of the display indicates'); writeln('the mode.'); writeln('The two other digits indicates the'); writeln('color.'); writeln; writeln('Press the middle key to change mode.'); writeln('Press the right key to change color.'); writeln('Press the left key to stop.'); writeln; writeln('Press any joystick key to start.'); end; (* init_text *) begin alloff; init_text; blink_wait; repeat grafmode; (* Move to current position without drawing *) pen_mode(invisible); analog(x,y); moveto(x,y*3 div 4); pen_mode(substitute); (* Starting conditions *) pen_color(black); (* Indicators *) lights(2,1); lights(1,0); lights(0,1); lights(3,6); (* Left LED on *) curr_color := black; (* Set default conditions *) curr_mode := substitute; (* To avoid uncontrollable autorepeating, we must know when a key is pressed the first time. Since some key was used to start the program, we don't want to recognize that key as a selection. *) first_press := false; repeat (* Draw to the new joystick position *) analog(x,y); moveto(x,y*3 div 4); (* See if change of something is desired *) keycode := keys; if first_press and (keycode=2) then begin first_press := false; if curr_mode0 do; (* Make sure the key is released *) textmode; gotoxy(0,20); writeln('Press the lit key to restart.'); writeln('Press any other key to stop.'); lights(3,2); while keys=0 do; (* Wait for some key *) until keys<>4; alloff; end. (* turttest7 *) Created at Oct 2, Tue, 22:43.41 TURTLE:TURTTEST8.TEXT program turttest8; (* Test of random printing, as well as the combination of Swedish character definitions and turtlegraphics *) (* 921125 *) uses swedish, extrascreen, (*$U turtleunit.code *) turtlegraphics; var i :integer; procedure checkprint; (* Halts and produces a hard copy if 'p' is pressed *) var code :integer; begin repeat code := bufscan; until code<>-1; if code=ord('p') then hardcopy; end; (* checkprint *) begin grafmode; for i := 1 to 10 do begin moveto(10+i,180-15*i); w_string('Hej i lingonskogen'); while bufscan=-1 do; end; checkprint; initturtle; for i := 1 to 32 do begin moveto(10+i,180-5*i); w_string('Evy ikl{dd leopard-unitights!'); end; checkprint; textmode; end. Created at Oct 2, Tue, 22:43.53 TURTLE:TURTTEST9.TEXT program turttest9; (* Further test of turtlegraphics with text *) uses realtime, extrascreen, random, (*$U turtleunit.code *) turtlegraphics; var code :integer; timer :timerid; line1, line2 :string; procedure stringit(timer :timerid; var line :string); (* Converts the current timer readout to a string *) var mstr, sstr, fstr :string; time :ttime; begin tmrread(timer,time); with time do begin str(minute,mstr); str(second,sstr); str(fract,fstr); sstr := concat('0',sstr); fstr := concat('00',fstr); sstr := copy(sstr,length(sstr)-1,2); fstr := copy(fstr,length(fstr)-2,3); line := concat(mstr,':',sstr,',',fstr); end; (* with *) end; (* stringit *) procedure grafinit; (* Draws axis *) begin grafmode; moveto(31,0); pen_mode(draw); moveto(255,0); moveto(31,0); moveto(31,191); moveto(31,144); moveto(255,144); pen_mode(none); moveto(255,96); pen_mode(draw); moveto(31,96); moveto(31,48); moveto(255,48); pen_mode(none); moveto(15,0); w_string('0%'); moveto(9,44); w_string('25%'); moveto(9,92); w_string('50%'); moveto(9,140); w_string('75%'); moveto(5,184); w_char('1'); moveto(9,184); w_string('00%'); end; (* grafinit *) procedure drawing(timer :timerid); (* Draws the actual graph *) var total :real; i :integer; begin tmrreset(timer); tmrstart(timer); total := rnd_int(192)-1; pen_mode(none); moveto(31,trunc(total)); pen_mode(draw); for i := 32 to 255 do begin total := total+rnd_int(192)-1; moveto(i,round(total/(i-30))); pen_mode(underwrite); end; tmrstop(timer); end; (* drawing *) begin randomize; grafinit; tmrnew(timer); drawing(timer); stringit(timer,line1); pen_color(white); drawing(timer); stringit(timer,line2); pen_mode(none); moveto(200,14); w_string(line1); moveto(200,6); w_string(line2); tmrdispose(timer); repeat code := bufscan; until code<>-1; if code=ord('p') then hardcopy; textmode; end. Created at Oct 2, Tue, 22:44.17 TURTLE:TURTTEST10.TEXT program turttest10; (* Further test of turtlegraphics with text and color *) (* A-DATA 870410 *) uses support, realtime, extrascreen, random, (*$U turtleunit.code *) turtlegraphics; const maxrate = 225; (* Maximal filter memory *) var rate, code :integer; line1, line2 :string; procedure stringit(timer :timerid; var line :string); (* Converts the current timer readout to a string *) var mstr, sstr, fstr :string; time :ttime; begin tmrread(timer,time); with time do begin str(minute,mstr); str(second,sstr); str(fract,fstr); sstr := concat('0',sstr); fstr := concat('00',fstr); sstr := copy(sstr,length(sstr)-1,2); fstr := copy(fstr,length(fstr)-2,3); line := concat(mstr,':',sstr,',',fstr); end; (* with *) end; (* stringit *) procedure grafinit; (* Draws axis *) begin (* Gives a darker background *) set_scr_color(ord(black),ord(red2)); grafmode; (* Draw the axis in the diagram *) moveto(31,0); pen_mode(draw); moveto(255,0); moveto(31,0); moveto(31,191); moveto(31,144); moveto(255,144); pen_mode(none); moveto(255,96); pen_mode(draw); moveto(31,96); moveto(31,48); moveto(255,48); pen_mode(none); moveto(15,0); (* Annotate with numericals *) w_string('0%'); moveto(9,44); w_string('25%'); moveto(9,92); w_string('50%'); moveto(9,140); w_string('75%'); (* Place the '1' in '100' closer to the zeroes *) moveto(5,184); w_char('1'); moveto(9,184); w_string('00%'); end; (* grafinit *) procedure sketch(rate :integer; var line1,line2 :string); (* Produces the drawing *) var timer :timerid; procedure drawing1(timer :timerid); (* Draws the average graph *) (* Color is black *) var total :real; i :integer; begin (* drawing1 *) tmrreset(timer); tmrstart(timer); total := rnd_int(192)-1; pen_mode(none); moveto(31,trunc(total)); pen_mode(draw); for i := 32 to 255 do begin total := total+rnd_int(192)-1; moveto(i,round(total/(i-30))); end; tmrstop(timer); end; (* drawing1 *) procedure drawing2(rate :integer; timer :timerid); (* Draws the filtered graph. Filtering technique is moving average *) (* Color is white with underwrite *) var average, i, j :integer; sample :array[0..maxrate] of integer; begin (* drawing2 *) fillchar(sample,sizeof(sample),chr(0)); tmrreset(timer); tmrstart(timer); pen_color(white); pen_mode(none); sample[31 mod rate] := rnd_int(192)-1; moveto(31,sample[31 mod rate]); pen_mode(underwrite); for i := 32 to 255 do begin sample[i mod rate] := rnd_int(192)-1; average := 0; for j := 0 to rate-1 do average := average+sample[j]; if (i-2)0) and (rate<=maxrate); (* Make the drawing *) grafinit; sketch(rate,line1,line2); notes(rate,line1,line2); (* Display result, and print if desired *) repeat code := bufscan; until code<>-1; if code=ord('p') then hardcopy; textmode; end. Created at Oct 2, Tue, 22:45.00 TURTLE:TURTTEST11.TEXT program turttest11; (* Further test of turtlegraphics with text and color *) uses analogbox, support, realtime, extrascreen, random, (*$U turtleunit.code *) turtlegraphics; var code :integer; timer :timerid; line1, line2 :string; procedure stringit(timer :timerid; var line :string); (* Converts the current timer readout to a string *) var mstr, sstr, fstr :string; time :ttime; begin tmrread(timer,time); with time do begin str(minute,mstr); str(second,sstr); str(fract,fstr); sstr := concat('0',sstr); fstr := concat('00',fstr); sstr := copy(sstr,length(sstr)-1,2); fstr := copy(fstr,length(fstr)-2,3); line := concat(mstr,':',sstr,',',fstr); end; (* with *) end; (* stringit *) procedure grafinit; (* Draws axis *) begin (* Gives a darker background *) set_scr_color(ord(black),ord(red2)); grafmode; (* Draw the axis in the diagram *) moveto(31,0); pen_mode(draw); moveto(255,0); moveto(31,0); moveto(31,191); moveto(31,144); moveto(255,144); pen_mode(none); moveto(255,96); pen_mode(draw); moveto(31,96); moveto(31,48); moveto(255,48); pen_mode(none); moveto(15,0); (* Annotate with numericals *) w_string('0%'); moveto(9,44); w_string('25%'); moveto(9,92); w_string('50%'); moveto(9,140); w_string('75%'); (* Place the '1' in '100' closer to the zeroes *) moveto(5,184); w_char('1'); moveto(9,184); w_string('00%'); end; (* grafinit *) procedure drawing1(timer :timerid); (* Draws joystick data with separate sampling *) var sample :array[31..255] of integer; x, y, i :integer; begin tmrreset(timer); tmrstart(timer); for i := 31 to 255 do analog(x,sample[i]); tmrstop(timer); pen_mode(none); moveto(31,(sample[31]*3) div 4); pen_mode(draw); for i := 32 to 255 do begin moveto(i,(sample[i]*3) div 4); end; end; (* drawing1 *) procedure drawing2(timer :timerid); (* Draws the joystick data with simultaneous sampling *) var x, y, i :integer; begin tmrreset(timer); tmrstart(timer); pen_color(white); pen_mode(none); analog(x,y); moveto(31,(y*3) div 4); pen_mode(draw); for i := 32 to 255 do begin analog(x,y); moveto(i,(y*3) div 4); pen_mode(underwrite); end; tmrstop(timer); end; (* drawing2 *) begin randomize; grafinit; tmrnew(timer); drawing1(timer); stringit(timer,line1); drawing2(timer); stringit(timer,line2); (* Display the time used for each graph *) pen_mode(none); moveto(200,14); w_string(line1); moveto(200,6); w_string(line2); tmrdispose(timer); (* Display result, and print if desired *) repeat code := bufscan; until code<>-1; if code=ord('p') then hardcopy; textmode; end. Created at Oct 2, Tue, 22:45.32 TURTLE:TURTTEST12.TEXT program turttest12; (* Further test of turtlegraphics with text and color *) uses analogbox, support, realtime, extrascreen, (*$U turtle:turtleunit.code *) turtlegraphics; var code :integer; procedure stringit(timer :timerid; var line :string); (* Converts the current timer readout to a string *) var mstr, sstr, fstr :string; time :ttime; begin tmrread(timer,time); with time do begin str(minute,mstr); str(second,sstr); str(fract,fstr); sstr := concat('0',sstr); fstr := concat('00',fstr); sstr := copy(sstr,length(sstr)-1,2); fstr := copy(fstr,length(fstr)-2,3); line := concat(mstr,':',sstr,',',fstr); end; (* with *) end; (* stringit *) procedure grafinit; (* Draws axis *) begin (* Gives a darker background *) set_scr_color(ord(black),ord(red2)); grafmode; (* Draw the axis in the diagram *) moveto(31,0); pen_mode(draw); moveto(255,0); moveto(31,0); moveto(31,191); moveto(31,144); moveto(255,144); pen_mode(none); moveto(255,96); pen_mode(draw); moveto(31,96); moveto(31,48); moveto(255,48); pen_mode(none); moveto(15,0); (* Annotate with numericals *) w_string('0%'); moveto(9,44); w_string('25%'); moveto(9,92); w_string('50%'); moveto(9,140); w_string('75%'); (* Place the '1' in '100' closer to the zeroes *) moveto(5,184); w_char('1'); moveto(9,184); w_string('00%'); end; (* grafinit *) procedure drawing2; (* Draws the temperature data with simultaneous sampling *) var x, y, i, savetime :integer; timer :timerid; time :ttime; begin tmrnew(timer); tmrstart(timer); tmrread(timer,time); savetime := time.second; pen_color(white); pen_mode(none); analog(x,y); moveto(31,(y*3) div 4); pen_mode(draw); for i := 32 to 255 do begin repeat tmrread(timer,time) until (time.second div 10)<>(savetime div 10);; savetime := time.second; analog(x,y); pen_mode(underwrite); moveto(i,(y*3) div 4); end; tmrstop(timer); tmrdispose(timer); end; (* drawing2 *) begin (* turttest12 *) grafinit; drawing2; (* Display result, and print if desired *) repeat code := bufscan; until code<>-1; if code=ord('p') then hardcopy; textmode; end. (* turttest12 *) Created at Oct 2, Tue, 22:45.58 TURTLE:CADTEST.TEXT program cadtest; uses extrascreen, (*$U turtleunit.code *) turtlegraphics; type figtype = array[1..8,1..3] of integer; transtype = array[1..3,1..3] of integer; var drawing, figure :figtype; transarr :transtype; i, loopcount :integer; indata :text; filename :string; procedure makefigure(var figure :figtype); procedure fillrow(var arr :figtype; row,x,y,z :integer); begin arr[row,1] := x; arr[row,2] := y; arr[row,3] := z; end; (* fillrow *) begin fillrow(figure,1,1,3,-2); fillrow(figure,2,-1,-2,-2); fillrow(figure,3,2,-2,-7); fillrow(figure,4,4,3,-7); fillrow(figure,5,1,3,8); fillrow(figure,6,-1,-2,8); fillrow(figure,7,2,-2,3); fillrow(figure,8,4,3,3); end; (* makefigure *) procedure maketrans(var datafile :text; var trans :transtype); var row, value1, value2, value3 :integer; begin for row := 1 to 3 do begin readln(datafile,value1,value2,value3); trans[row,1] := value1; trans[row,2] := value2; trans[row,3] := value3; end; (* for *) end; (* maketrans *) procedure drawit(var arr :figtype); var i :integer; begin (* Translate picture *) for i := 1 to 8 do begin arr[i,1] := arr[i,1]+128; arr[i,2] := arr[i,2]+96; end; (* for *) grafmode; moveto(arr[1,1],arr[1,2]); pen_mode(draw); for i := 2 to 4 do moveto(arr[i,1],arr[i,2]); moveto(arr[1,1],arr[1,2]); for i := 5 to 8 do moveto(arr[i,1],arr[i,2]); moveto(arr[4,1],arr[4,2]); hardcopy; while bufscan=-1 do; textmode; end; (* drawit *) procedure multiply(var arr3,arr1 :figtype; var arr2 :transtype); var row, col, accum, i :integer; begin for row := 1 to 8 do for col := 1 to 3 do begin accum := 0; for i := 1 to 3 do accum := accum+arr1[row,i]*arr2[i,col]; arr3[row,col] := accum; end; (* for *) end; (* multiply *) begin (* cadtest *) write('Transposition data file name? '); readln(filename); reset(indata,filename); readln(indata,loopcount); readln(indata); makefigure(figure); for i := 1 to loopcount do begin maketrans(indata,transarr); multiply(drawing,figure,transarr); drawit(drawing); end; end. Created at Oct 2, Tue, 22:46.23 TURTLE:VDPLOOK.TEXT program vdplook; (* Allows study of contents of VDP RAM *) (* Various items copied from modrs232 *) const rddata = -30720; rdstat = -30718; wrtdata = -29696; wrtaddr = -29694; wrtenab = 16384; type byte = 0..255; window = record case boolean of true: (int: integer); false:(ptr:^integer); end; var cpuaddr: window; vdpaddr: integer; savevdpaddr: integer; ch: char; temp, addr, stopaddr: integer; procedure swapbyte(var x:integer); (* This procedure takes a word and reverses the order of the bytes *) type byteword = record case boolean of true: (addr:integer); false:(bytes: packed array[1..2] of byte); end; var word: byteword; tbyte: byte; begin with word do begin addr := x; tbyte := bytes[1]; bytes[1] := bytes[2]; bytes[2] := tbyte; x := addr; end; (* with statement *) end; (* procedure *) procedure wrtvdpaddr (vdpaddr : integer); (* This procedure initializes the VDP ram chip to read/write from the * * address passed in the parameter vdpaddr. *) begin cpuaddr.int := wrtaddr; swapbyte( vdpaddr ); cpuaddr.ptr^ := vdpaddr; swapbyte( vdpaddr ); cpuaddr.ptr^ := vdpaddr; end; (* procedure *) function rdvdp (var vdpaddr : integer) : integer; (* This function reads a byte of data from the VDP ram address specified * * in the parameter vdpaddr. *) begin wrtvdpaddr( vdpaddr ); cpuaddr.int := rddata; rdvdp := cpuaddr.ptr^ div 256; (* Right justify byte in word *) vdpaddr := vdpaddr + 1; end; (* procedure *) procedure wrtvdp( var vdpaddr : integer; data : integer); (* This procedure writes the byte of data passed in the parameter * * data to the VDP ram address specified in vdpaddr. *) var temp : integer; begin temp := vdpaddr + wrtenab; (* Write enable the address *) wrtvdpaddr(temp); cpuaddr.int := wrtdata; cpuaddr.ptr^ := data * 256; (* Left justify byte in word and write *) vdpaddr := vdpaddr + 1; end; (* procedure *) procedure poke(addr,value:integer); (* Stores value at addr in CPU RAM *) var memaddr:window; begin memaddr.int := addr; memaddr.ptr^ := value; end; (* poke *) begin (* main *) write('Start '); readln(addr); write('Stop '); readln(stopaddr); while addr