From 9e2d4bf297abdefe3ef82699954b8cc6183a889c Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Mon, 13 Apr 2026 22:41:00 +0200 Subject: [PATCH] COLOR HACK - display hacks for the color scope. Written by Michael Beeler. --- build/ka10/processor.tcl | 3 + build/timestamps.txt | 1 + doc/programs.md | 1 + src/mb/color.23 | 2761 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 2766 insertions(+) create mode 100755 src/mb/color.23 diff --git a/build/ka10/processor.tcl b/build/ka10/processor.tcl index 57822f10..5166e650 100644 --- a/build/ka10/processor.tcl +++ b/build/ka10/processor.tcl @@ -129,6 +129,9 @@ midas "sys2;ts munch" "sysen2;munch" # TITLER midas "dsk0:.;@ titler" "mb; titler" +# COLOR HACK - display hacks for the color scope +midas "dsk0:pdp10;color hack" "mb; color" + # MLIFE omidas "games;ts mlife" "rwg;mlife" omidas "/t dsk0:.;@ mlife" "rwg;mlife" { diff --git a/build/timestamps.txt b/build/timestamps.txt index 06287725..d98d47eb 100644 --- a/build/timestamps.txt +++ b/build/timestamps.txt @@ -1794,6 +1794,7 @@ maxtul/query.6 198107020034.34 maxtul/strmrg.70 198107181941.49 maxtul/timepn.1 198012121633.43 maxtul/toolm.1 198107151807.50 +mb/color.23 197110040236.34 mb/titler.3 197109212338.08 mb/hakmem.141 197203160000.00 mb/hakmem.17 197101010000.00 diff --git a/doc/programs.md b/doc/programs.md index 885782bb..c8c6bcbd 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -64,6 +64,7 @@ - CLOCK, analogue, small, or digital clock. - CLOGO, Logo programming language. - CLU, compiled programming language. +- COLOR HACK, display hacks for the color scope. - COMBAT, submit jobs to the Muddle compiler. - COMIFY, convert HEX to COM format. - COMPLR, Lisp compiler. diff --git a/src/mb/color.23 b/src/mb/color.23 new file mode 100755 index 00000000..b11eeff2 --- /dev/null +++ b/src/mb/color.23 @@ -0,0 +1,2761 @@ +TITLE PDP-10 COLOR SCOPE PROGRAMS + +A=1 +B=2 +C=3 +D=4 +E=5 +F=6 +G=7 +R=10 +S=11 +T=12 +U=13 +X=14 +Y=15 +Z=16 +P=17 + +RN2==U+1 +TIME==15 ;FOR WIREF + +DEFINE FIX X + MULI X,400 + TSC X,X + ASH X+1,-243(X) +TERMIN + +DEFINE FLOAT X + TLC X,232000 + FADR X,X +TERMIN + +DEFINE RANDT + MOVE T,U + MUL T,[11060471625] + DIV T,[SETZ-37] ;RANDOMNESS IN T EXCEPT TOP FEW BITS +TERMIN + +DEFINE RANDU + MOVE U,RN2 + MUL U,RN1 + DIV U,[SETZ-37] ;RANDOMNESS IN U EXCEPT TOP FEW BITS +TERMIN + CSCOP==420 + +WHITE==313733+40 +PINK==370037+40 ;REALLY MAGENTA (PINK = 312525) +RED==370000+40 +ORANGE==372700+40 +YELLOW==363600+40 +YELGRN==313700+40 +GREEN==003700+40 +BLUGRN==003730+40 +BLUE==000037+40 +VIOLET==270037+40 + +;CONO 420 BITS (20 BIT IS ENABLE, SO INTENSITIES < 20 = OFF) +;370000 RED INTENSITY +;003700 GREEN INTENSITY +;000037 BLUE INTENSITY +;40 ENABLE SWITCHES + +;DATAO 420 BITS +;0,,777000 X DEFLECTION +;0,,000777 Y DEFLECTION + +;DATA SWITCHES SETTINGS FOR MUNCHING SQUARES (LEFT HALF) + +; 000004 +; 001000 +; 001400 +; 001401 (= 401400) +; 002000 +; 002001 +; 002002 +; 002777 +; 252525 + OR - 1 BIT OR BITS NEAR CENTER +; 401000 +; 525253 +; 631463 +; 653124 +; 653125 +; 774007 +; XYZ<1'S COMPLEMENT OF XYZ> + LOC 62 +REPEAT 24,JSP A,START ;REPEAT COUNT MUST BE CHANGED IF HACKS ARE ADDED + +START: MOVSI B,400000 + JFCL 17,.+1 + JRST .+1 ;IF ON PDP-6, SET PC CHANGE FLAG + JFCL 1,.+2 + .IOTLS B, + CONO CSCOP,40 + MOVE A,STARTT-63(A) + HRRM A,START1 + CLEARB A,B +START1: JRST + +STARTT: CIRCLE ;62 + PLUS + SQUARE + RASTER + CROSS + BOX + + WIREF ;70 + OCEAN + FLAME + LIGHT + STREK + SPIRAL + PSYCH + MUNCH + + KSCOPE ;100 + WORM + VNOISE + SCURVY + MTRON + FORMS + ;TITLE PYROTECHNICS +;USES 400 WORDS OF OCEAN'S SINTAB + +NCLUS==3 ;NUMBER OF CLUSTERS +NSPUR==100 ;NUMBER OF SPURS PER CLUSTER + +RADIX 2 +%A==10001100011000111111100011000101110 +%B==11110100011000111110100011000111110 +%C==01110100011000010000100001000101110 +%D==11110100011000110001100011000111110 +%E==11111100001000011110100001000011111 +%F==10000100001000011110100001000011111 +%G==01110100011001110000100001000101110 +%H==10001100011000111111100011000110001 +%I==01110001000010000100001000010001110 +%J==01110100010000100001000010000100111 +%K==10001100011001011100101001001010001 +%L==11111100001000010000100001000010000 +%M==10001100011000110001101011101110001 +%N==10001100011001110101110011000110001 +%O==01110100011000110001100011000101110 +%P==10000100001000011110100011000111110 +%Q==01111100111010110001100011000101110 +%R==10001100011000111110100011000111110 +%S==01110100010000101110100001000101110 +%T==00100001000010000100001000010011111 +%U==01110100011000110001100011000110001 +%V==00100010101000110001100011000110001 +%W==01010101011000110001100011000110001 +%X==10001100010101000100010101000110001 +%Y==00100001000010000100010101000110001 +%Z==11111010000010001110001000001011111 +%STAR==00000101010111011011011101010100000 +%DASH==00000000000000011111000000000000000 +RADIX 8 + WIREF: MOVEI TIME,0 +DIS0: HRLZI E,-4 ;POINTER TO CURRENT END OF INTERPRETED DISLIST +DIS1: MOVEI F,0 ;POINTER TO CURRENTLY INTERPRETED DISLIST ENTRY +DIS2: SKIPL C,DISL(F) + JRST CHAR + HLR T,C + ANDI T,7 + XCT DISOPR(T) + JRST DIS3 ;READY FOR NEXT DISLIST ENTRY + MOVEI T,DISEND-DISL ;END DISLIST INTERPRETING + SUB T,F + IMULI T,600 + SOJG T,. + AOJA TIME,DIS1 + +DIS3: CAIE F,(E) + AOJA F,DIS2 + MOVEI T,DISEND-DISL + SUB T,F + IMULI T,600 + SOJG T,. + MOVSS E + AOS E + TRNN E,-1 + HRRI E,-4 + MOVSS E + JRST DIS1 + +DISOPR: JRST . + HRRZ D,C ;UPDATE X,Y TO THIS + CONO CSCOP,(C) ;CONO THIS COLOR + CAIL TIME,(C) ;END DISLIST IF TIME < THIS + HRRM C,CHAR6 ;UPDATE CHARACTER SIZE TO THIS + JRST DDONE ;DISPLAY DONE + +CHAR: MOVSI B,-7 ;SCANS INCREMENTAL Y + HRRZ T,CHAR6 + IMULI T,7000 + HRRM T,CHAR4 +CHAR1: MOVSI A,-5 ;SCANS INCREMENTAL X +CHAR2: TLNE C,200000 + JRST CHAR5 +CHAR3: LSH C,1 + AOBJN A,CHAR2 + AOBJN B,CHAR1 +CHAR4: ADDI D,7000 ;DX = 7 * SIZE, DY = 0 + JRST DIS3 ;CHARACTER DONE + +CHAR5: MOVEI T,(A) + LSH T,9 + IORI T,(B) +CHAR6: IMULI T,1 ;SIZE + ADD T,D + DATAO CSCOP,T + MOVEI T,24 + SOJG T,. + JRST CHAR3 + DISL: 400001,,000500 + 400002,,003400 + 400004,,000010 + %W + %I + %R + %E + %F + %O + %R + %K + %S + 400001,,070300 + 400002,,000027 + 400004,,000003 + %A + 0 ;SPACE + %B + %E + %E + %L + %E + %R + 0 + %P + %R + %O + %D + %U + %C + %T + %I + %O + %N + 400001,,364300 + 400002,,370000 + %DASH + %DASH + %DASH + %DASH + %DASH + %DASH + %DASH + %DASH + %DASH + %DASH + 400001,,451240 + %C + %R + %O + %C + %K + 400005,,000000 +DISEND==. + DDONE: MOVEI P,PDL-1 + MOVE RN2,RN1 + MOVEI TIME,0 ;AND IN THE BEGINNING, + CLEARM TSPUR + MOVE T,[TSPUR,,TSPUR+1] + BLT T,TSPUR+NSPUR*NCLUS-1 + +SETSIN: MOVSI A,-400 ;SET UP SINE TABLE + CLEARM B +SETS1: FADR B,[.OP FDVR 3.14159265 128.0 ] + MOVE T,B + PUSHJ P,SINE + FSC T,10 + FADR T,[0.5] + FIX T + MOVEM U,SINTAB(A) + AOBJN A,SETS1 + + JRST TOP + TOP: AOS A,CLSNUM ;NUMBER OF NEXT CLUSTER + CAIL A,NCLUS + CLEARB A,CLSNUM + SKIPN A + AOS TIME + MOVE B,CLSTAT(A) ;CLUSTER STATE + XCT DONOW(B) + +DONOW: JRST IDLE ;CLUSTER IS IDLE, MAY BE USED + JRST SLEP1 ;SLEEPING BEFORE SET-UP + JRST SHOOT ;SHOOTING UP + JRST REDY1 ;READY FOR SET-UP + JRST REDY2 ;READY FOR SECOND HALF OF SET-UP + JRST BURN ;CLUSTER IS BURNING + JRST IMMED ;USE IMMEDIATELY + +IDLE: TLNE B,-1 + JRST IDLE1 ;CLUSTER BEING HELD FOR GANG FORMATION + SKIPE TGANG + JRST IDLE3 ;HOLD CLUSTER FOR GANG FORMATION + RANDU + TRNN U,7 + JRST IDLE2 ;START A GANG FORMATION + AOS CLSTAT(A) + PUSHJ P,GSPOT + RANDU + ANDI U,177 + MOVNM U,TCLUS(A) +IDLE0: MOVEI T,44.*NSPUR ;APPROXIMATELY + SOJG T,. + JRST TOP + +IDLE1: LDB T,[220300,,B] + CAIE T,(A) + JRST IDLE0 ;NOT MASTER OF GANG + SKIPE NGANG(A) + JRST IDLE0 ;SLAVES NOT READY + PUSHJ P,GSPOT + CLEARM TCLUS(A) + AOS CLSTAT(A) + AOS CLSTAT(A) + LDB T,[250300,,CLSTAT(A)] + JRST @GANG(T) + +GANG: GANG0 + GANG1 + GANG2 + GANG2 + GANG2 + GANG3 + GANG3 + GANG4 + GSPOT: RANDU ;GET SPOT, SIZE OF EXPLOSION + ANDI U,777 + ADDI U,400 + MOVE D,U + LSH D,24 ;X OF CLUSTER + RANDU + ANDI U,377 + ADDI U,1000 + MOVE E,U + LSH E,24 ;Y OF CLUSTER + RANDU + ANDI U,77 + ADDI U,41 + MOVE B,U ;OVERALL CLUSTER DIAMETER + RANDU + MOVE T,U + IDIVI T,10. + MOVE T,COLORS(U) + MOVEM T,CCOLOR(A) + MOVEI T,(A) + LSH T,2 + MOVE U,[B,,SAVEAC] + ADD U,T + BLT U,SAVEAC+3(T) + POPJ P, + +GANG0: PUSHJ P,GANGM3 + JRST TOP + +GANG1: PUSHJ P,GANGM3 + MOVEI U,20 + ADDM U,TCLUS(T) + LSH T,24 + MOVE U,[SAVEAC,,B] + ADD U,T + BLT U,E + PUSHJ P,GANGM3 + JRST TOP + +GANG2: MOVE F,B + PUSHJ P,GANGM4 + JRST TOP + +GANG3: MOVE F,B + PUSHJ P,GANGM4 + MOVEI U,20 + ADDM U,TCLUS(T) + PUSHJ P,GETACS + PUSHJ P,GANGM4 + JRST TOP + GANG4: MOVSI T,1000 + IORM T,CLSTAT(A) + MOVE F,B + LSH F,5 + ADD F,B + LSH B,-1 + SETOM FLAG1 + PUSHJ P,GANGM4 + MOVE T,[B,,SAVEAC+4*NCLUS] + BLT T,SAVEAC+4*NCLUS+3 + PUSHJ P,GETACS + LSH B,-1 + PUSHJ P,GANGM4 + PUSHJ P,GETACS + LSH B,-1 + PUSHJ P,GANGM4 + JRST TOP + +GANGM1: MOVEI T, +GANGM2: HRRZ U,CLSTAT(T) + CAIE U, + AOJA T,GANGM2 ;NOT IDLE + LDB U,[220300,,CLSTAT(T)] + CAIE U,(A) + AOJA T,GANGM2 + LSH T,2 + MOVE U,[B,,SAVEAC] + ADD U,T + BLT U,SAVEAC+3(T) + LSH T,-2 + RANDU + MOVE B,U + IDIVI B,10. + MOVE U,COLORS(C) + MOVEM U,CCOLOR(T) + AOS B,CLSTAT(T) + MOVSS B + ANDI B,7 + MOVE B,CLSTAT(B) + LSH B,-25 + ANDI B,7 ;GANG FORMATION INDEX + RANDU + ANDI U,17 + ADD U,GTIME(B) + MOVNM U,TCLUS(T) + POPJ P, + +FLAG1: 0 ;-1 = GANGM4 SHOULD NOT GO TO GANGM1 + +GTIME: 500 + 500 + 440 + 440 + 440 + 500 + 500 + 1000 + GANGM3: MOVN T,B + ASH T,-1 + ADDB T,B + LSH T,26 + ADDM T,E + JRST GANGM1 + +GANGM4: PUSH P,F + RANDU + ANDI U,377 + IMUL F,SINTAB(U) ;F HAS SCALED B + RANDU + ANDI U,377 + MOVE T,SINTAB(U) + IMUL T,F + ADDM T,D ;X + ADDI U,100 + ANDI U,377 + MOVE T,SINTAB(U) + IMUL T,F + ADDM T,E ;Y + POP P,F + AOSE FLAG1 + JRST GANGM1 + POPJ P, + +GETACS: MOVSI T,(A) + LSH T,2 + MOVE U,[SAVEAC,,B] + ADD U,T + BLT U,E + POPJ P, + +IDLE2: RANDU ;START A GANG + ANDI U,7 + MOVN T,NUMG(U) + MOVEM T,NGANG(A) + ADDM T,TGANG + LSH U,3 + IORI U,400(A) + HRLM U,CLSTAT(A) + MOVEI T,44.*NSPUR-16. + SOJG T,. + JRST TOP + +IDLE3: MOVEI B, ;HOLD CLUSTER FOR GANG + SKIPL NGANG(B) + AOJA B,.-1 + AOS NGANG(B) + AOS TGANG + MOVEI B,400(B) + HRLM B,CLSTAT(A) + MOVEI T,44.*NSPUR-16. + SOJG T,. + JRST TOP + SLEP1: AOSGE B,TCLUS(A) + JRST SLEP11 + AOS B,CLSTAT(A) + TLNN B,-1 + JRST SLEP11 ;CLUSTER NOT SLAVED + LSH B,-22 + ANDI B,7 + CAIE B,(A) + AOS CLSTAT(A) +SLEP11: MOVEI T,44.*NSPUR ;APPROXIMATELY + SOJG T,. + JRST TOP + +SHOOT: AOS T,TCLUS(A) + CONO CSCOP,RED + CAIL T,400 + AOS CLSTAT(A) ;SHOOT DONE + MOVEI B,(A) + LSH B,2 + HLRZ C,SAVEAC+3(B) ;Y + MOVE B,SAVEAC+2(B) ;X + IMUL C,T + LSH C,-13 + LSH B,-14 + ANDI B,777000 + IORI C,(B) + RANDU + TRNN U,77 + DATAO CSCOP,C + MOVEI T,44.*NSPUR-26. + SOJG T,. + JRST TOP + +REDY1: AOS CLSTAT(A) + PUSHJ P,GETACS + LSH A,6 ;LN2 NSPUR + HRLI A,-NSPUR/2 + PUSHJ P,GCLUS + JRST TOP + REDY2: CLEARM T + AOS B,CLSTAT(A) + TLNN B,-1 + HRLZI T,10 ;INITIAL VYCLUS (CLUSTER NOT GANGED) + LSH B,-22 + ANDI B,7 + CAIN B,(A) + HRLZI T,10 ;INITIAL VYCLUS (CLUSTER IS MASTER) + MOVE C,CLSTAT(B) + LSH C,-25 + ANDI C,7 + CAIL C,2 + CAIN C,7 + SKIPA + HRLZI T,10 ;INITIAL VYCLUS (FORMATIONS 2-6) + MOVEM T,VYCLUS(A) + PUSHJ P,GETACS + LSH A,6 ;LN2 NSPUR + ADDI A,NSPUR/2 + HRLI A,-NSPUR/2 + PUSHJ P,GCLUS + JRST TOP + +BURN: MOVE T,CCOLOR(A) + CONO CSCOP,(T) + MOVE E,VYCLUS(A) + LSH A,6 ;LN2 NSPUR + HRLI A,-NSPUR + PUSHJ P,MAIN + HRLZI T,-5 ;TERMINAL VYCLUS + SUB T,E + ASH T,-5 + ADD T,E + MOVE A,CLSNUM + MOVEM T,VYCLUS(A) + SKIPE D ;NUMBER OF SPURS STILL BURNING + JRST TOP + MOVEI T, + EXCH T,CLSTAT(A) + TLZN T,1000 + JRST TOP + AOS T + MOVEM T,CLSTAT(A) ;USE IMMEDIATELY + JRST TOP + +IMMED: MOVEI T,3 ;REDY1 + MOVEM T,CLSTAT(A) + MOVEI T,(A) + LSH T,2 + MOVE U,[SAVEAC+4*NCLUS,,SAVEAC] + ADD U,T + BLT U,SAVEAC+3(T) + RANDU + MOVE T,U + IDIVI T,10. + MOVE U,COLORS(U) + MOVEM U,CCOLOR(A) + JRST REDY1 + GCLUS: RANDU + ANDI U,77 + MOVE F,SINTAB(U) ;SPUR VELOCITY ACROSS SCOPE FACE + IMUL F,B + RANDU + ANDI U,377 + MOVE T,F + IMUL T,SINTAB(U) + MOVEM T,VXSPUR(A) + ADDI U,100 + ANDI U,377 + IMUL F,SINTAB(U) + MOVEM F,VYSPUR(A) + RANDU + ANDI U,377 + ADD U,TIME + ADDI U,200 + MOVEM U,TSPUR(A) + MOVEM D,XSPUR(A) + MOVEM E,YSPUR(A) + AOBJN A,GCLUS + POPJ P, + +MAIN: MOVEI D,NSPUR ;COUNTS BURNING SPURS +MAIN2: CAML TIME,TSPUR(A) + JRST MAIN4 + MOVN T,VXSPUR(A) + ASH T,-5 + ADDB T,VXSPUR(A) + ADDB T,XSPUR(A) + LSH T,-14 + MOVE B,T + MOVN T,VYSPUR(A) + ASH T,-5 + ADDB T,VYSPUR(A) + ADD T,E + ADDB T,YSPUR(A) + LSH T,-25 + ANDI B,777000 + IORI B,(T) + DATAO CSCOP,B + MOVEI T,10 + SOJG T,. +MAIN3: AOBJN A,MAIN2 + POPJ P, + +MAIN4: MOVEI T,120 + SOJG T,. + SOJA D,MAIN3 + COSINE: FADR T,SC1 +SINE: MOVEM U,TPOSAV + MOVEM T,SX + MOVMS T + CAMG T,SP2 + JRST S3A + FDV T,SC1 + CAMG T,SP1 + JRST SINE2 + MULI T,400 + ASH U,-202(T) + MOVEI T,200 + ROT U,3 + LSHC T,33 + FAD T,SP3 + JUMPE U,SINE2 + TLCE U,1000 + FSB T,SP1 ;01,11 + TLCE U,3000 + TLNN U,3000 + MOVNS T ;01,10 +SINE2: SKIPGE SX + MOVNS T + MOVEM T,SX + FMPR T,T + MOVE U,SC9 + FMP U,T + FAD U,SC7 + FMP U,T + FAD U,SC5 + FMP U,T + FAD U,SC3 + FMP T,U + FAD T,SC1 +S2B: FMPR T,SX +SINX: MOVE U,TPOSAV + POPJ P, + +S3A: MOVE T,SX + JRST SINX + +SC1: 1.57079631847 +SC3: -0.64597371106 +SC5: 0.07968967928 +SC7: -0.00467376557 +SC9: 0.00015148419 + +SP1: 1.0 +SP2: 170000000000 +SP3: 0 +CD1: 90.0 +SCD1: 206712273406 +SX: 0 +TPOSAV: 0 + RN1: 11060471625 ;5 TO THE THIRTEENTH + +SAVEAC: BLOCK NCLUS*4+4 ;SAVE B, C, D, E +CLSNUM: 0 ;INDEX OF CURRENT CLUSTER +CLSTAT: BLOCK NCLUS ;STATE OF CLUSTERS + ;1000,,0 IF MUST USE IMMEDIATELY ON BURN-OUT + ;400,,0 IF IN A FORMATION + ;70,,0 FORMATION NUMBER IF LEAD CLUSTER + ;7,,0 LEAD CLUSTER THIS CLUSTER IS GANGED TO + ;RIGHT HALF WORD HAS STATE NUMBER +VYCLUS: BLOCK NCLUS ;OVERALL Y VELOCITY OF CLUSTER +XSPUR: BLOCK NCLUS*200 ;X POSITION OF SPUR, WITH 14 BITS MORE SIG +YSPUR: BLOCK NCLUS*200 ;Y POSITION OF SPUR, WITH 14 BITS MORE SIG +VXSPUR: BLOCK NCLUS*200 ;X VELOCITY OF SPUR (MAX = 20,,0)??? +VYSPUR: BLOCK NCLUS*200 ;Y VELOCITY OF SPUR (NEGLECTING VYCLUS) +TSPUR: BLOCK NCLUS*200 ;TIME AT WHICH SPUR BURNS OUT + +NUMG: 1 ;NUMBER OF SLAVE CLUSTERS GANG FORMATION REQUIRES + 2 + 1 + 1 + 1 + 2 + 2 + 2 + +NGANG: BLOCK NCLUS ;NEEDED FOR GANG FORMATION +TGANG: 0 ;TOTAL OF NGANGS +TCLUS: BLOCK NCLUS ;TIMER ON CLUSTER WAITING +CCOLOR: BLOCK NCLUS ;COLOR OF CLUSTER +COLORS: PINK + RED + ORANGE + YELLOW + YELGRN + GREEN + BLUGRN + BLUE + VIOLET + WHITE + +PDL: BLOCK 20 +PATCH: BLOCK 100 + ;TITLE OCEAN +;USES WIREF'S COSINE SUBROUTINE +;USES WIREF'S PDL + +VELOC1==5 +VELOC2==VELOC1+1 +VELOC3==VELOC2+1 +VELOC4==VELOC3+1 +AMPL1==VELOC4+1 +AMPL2==AMPL1+1 +AMPL3==AMPL2+1 +AMPL4==AMPL3+1 + +BUFSIZ==24*24 + +OCEAN: MOVEI P,PDL-1 + + MOVSI A,-1000 ;SET UP SINE TABLE + CLEARM B +OSETS1: FADR B,[.OP FDVR 3.14159265 256.0 ] + MOVE T,B + PUSHJ P,SINE + FSC T,10 + FADR T,[0.5] + FIX T + MOVEM U,SINTAB(A) + AOBJN A,OSETS1 + + MOVN A,DEN + IMUL A,DEN + HRLZM A,NPTS1 + MOVE A,MOTSCL + SUBI A,7 + HRRM A,ASH1 + ADDI A,11 + HRRM A,ASH2 + SETLOC: MOVE A,SIZE ;SET UP LOCATION TABLE + MOVE B,DEN ;LINEAR DENSITY, MUST BE EVEN + SOS B + IDIV A,B + LSH B,1 + CAML B,SIZE + AOS A + MOVEM A,SPAC ;SPACING + IMUL A,DEN + SUB A,SPAC ;TRUE SIZE + LSH A,-1 + ADDI A,400 + IMULI A,1001 + MOVN B,DEN + IMUL B,DEN + HRLZS B + MOVEM A,LOCAT(B) ;CORNER CO-ORDINATES + MOVN C,DEN + HRLZS C + MOVN E,SPAC + ASH E,9 + AOBJN B,.+1 + ADD A,E +SETL2: MOVE F,E + MOVN D,DEN + AOS D + HRLZS D +SETL1: MOVEM A,LOCAT(B) ;ACROSS THE ROW + AOBJN B,.+1 + ADD A,F + AOBJN D,SETL1 + SUB A,F + SUB A,SPAC ;DOWN ONE SPACE + MOVNS E + AOBJN C,SETL2 + ADD A,F + ADD A,SPAC + MOVEM A,LOCAT(B) ;BACK TO EDGE COLUMN + AOBJN B,.+1 +SETL3: ADD A,SPAC + MOVEM A,LOCAT(B) ;UP FINAL EDGE + AOBJN B,SETL3 + MOVSI A,-4 +SETPH: MOVE B,ANGLE(A) ;SET UP PHASE, WAVE NUMBER (0-3) IN A + MOVEI C,200(B) + ANDI C,777 + MOVEI D,(A) + IMULI D,BUFSIZ + ADDI D,PHASE1 + HRRM D,SETP1 + MOVE F,NPTS1 +SETP2: MOVE D,LOCAT(F) + LSHC D,-9 + LSH E,-27. + IMUL D,SINTAB(C) + IMUL E,SINTAB(B) + ADD D,E + IDIV D,PERIOD(A) + MOVM T,E ;SIGNED ROUND + ASH T,1 + CAMGE T,PERIOD(A) + JRST SETP1 + AOS D + SKIPG E + SUBI D,2 +SETP1: MOVEM D,.(F) + AOBJN F,SETP2 + AOBJN A,SETPH + + MOVE 17,[VELOC,,VELOC1] + BLT 17,17 +OLOOP1: MOVE A,NPTS1 +OLOOP: CLEARB C,D + IRP X,,[1,2,3,4]Y,,[C,C,D,D] + MOVEI B,(VELOC!X) + ADDB B,PHASE!X!(A) + ANDI B,777 + MOVE B,SINTAB(B) + IMULI B,(AMPL!X) + ADD Y,B +TERMIN + MOVE B,C + ADD B,D + ASH B,-11 ;RANGE = +,-16. + MOVE B,COLOR(B) + CONO CSCOP,(B) + MOVE B,LOCAT(A) +ASH1: ASH C,-7 + ADD B,C +ASH2: ASH D,2 + ANDCMI D,777 + ADD B,D + JFCL + JFCL + JFCL + DATAO CSCOP,B + AOBJN A,OLOOP + JRST OLOOP1 + ;ANGLE 0 = LEFT TO RIGHT +;ANGLE 100 = NORTHWEST TO SOUTHEAST +;ANGLE 200 = TOP TO BOTTOM, ETC. + +;AMPLITUDE OF WAVES 1 & 2 AFFECT Y INCREMENTAL DEFLECTION +;AMPLITUDE OF WAVES 3 & 4 AFFECT X INCREMENTAL DEFLECTION +;SUM OF AMPLITUDES OF ALL WAVES AFFECTS COLOR + +;FOLLOWING BLOCK OF PARAMETERS IS TO BE COOLIE VARIED +SIZE: 200 ;RASTER DEFLECTION SIZE, 40-400 +DEN: 16 ;LINEAR DENSITY, MUST BE EVEN, <= 24 FOR THIS BUFSIZ +MOTSCL: 2 ;AMOUNT MOTION DATA IS ASHED W.R.T. THAT USED FOR COLOR, 0-2 +ANGLE: 400 ;WAVE ATTACK ANGLE, 0-777 + 100 + 600 + 700 +PERIOD: 300 ;CREST-TO-CREST DISTANCE, AROUND 1000 + 306 + 272 + 300 +VELOC: 2 ;WAVE PROPAGATION VELOCITY, 1-10 + 3 + 4 + 2 +AMPL: 10 ;AMPLITUDE, 0-10 + 14 + 12 + 6 + +NPTS1: 0 ;-DEN*DEN,,0 FOR AOBJNS +SPAC: 0 ;SPACING +SINTAB: BLOCK 1000 ;-400<=SINE<=+400 + + REPEAT 20.,VIOLET + REPEAT 4,VIOLET + REPEAT 5,BLUE + REPEAT 4,BLUGRN + REPEAT 3,GREEN +COLOR: REPEAT 2,GREEN + REPEAT 3,YELLOW + REPEAT 3,ORANGE + REPEAT 3,RED + REPEAT 3,PINK + REPEAT 3,WHITE + REPEAT 20.,WHITE + +LOCAT: BLOCK BUFSIZ ;0,,XY LOCATIONS +PHASE1: BLOCK BUFSIZ +PHASE2: BLOCK BUFSIZ +PHASE3: BLOCK BUFSIZ +PHASE4: BLOCK BUFSIZ + ;TITLE FLAME +;USES WIREF'S COSINE SUBROUTINE +;USES WIREF'S PDL +;USES OCEAN'S DEFINITION OF VELOC1-4 AND AMPL 1-4 +;USES OCEAN'S BUFSIZ +;USES OCEAN'S PHASE1-4 AND SINTAB + +FLAME: MOVEI P,PDL-1 ;ADAPTATION OF OCEAN + +FSETS: MOVSI A,-1000 ;SET UP SINE TABLE + CLEARM B +FSETS1: FADR B,[.OP FDVR 3.14159265 256.0 ] + MOVE T,B + PUSHJ P,SINE ;USES OCEAN PROGRAM'S SINE ROUTINE + FSC T,10 + FADR T,[0.5] + FIX T + MOVEM U,SINTAB(A) ;USES OCEAN'S SINE TABLE + AOBJN A,FSETS1 + + MOVSI A,-4 +FSETPH: MOVE B,FANGLE(A) ;SET UP PHASE, WAVE NUMBER (0-3) IN A + MOVEI C,200(B) + ANDI C,777 + MOVEI D,(A) + IMULI D,BUFSIZ ;USES OCEAN'S PARAMETER SETTING + ADDI D,PHASE1 ;USES OCEAN'S BUFFERS + HRRM D,FSETP1 + MOVE F,[-16*16,,0] +FSETP2: MOVE D,FLOCAT(F) + LSHC D,-9 + LSH E,-27. + IMUL D,SINTAB(C) + IMUL E,SINTAB(B) + ADD D,E + IDIV D,FPERIOD(A) + MOVM T,E ;SIGNED ROUND + ASH T,1 + CAMGE T,FPERIOD(A) + JRST FSETP1 + AOS D + SKIPG E + SUBI D,2 +FSETP1: MOVEM D,.(F) + AOBJN F,FSETP2 + AOBJN A,FSETPH + MOVE 17,[FVELOC,,VELOC1] + BLT 17,17 +FLOOP1: MOVE A,[-16*16,,0] +FLOOP: CLEARB C,D + IRP X,,[1,2,3,4]Y,,[C,C,D,D] + MOVEI B,(VELOC!X) + ADDB B,PHASE!X!(A) + ANDI B,777 + MOVE B,SINTAB(B) + IMULI B,(AMPL!X) + ADD Y,B +TERMIN + MOVE B,C + ADD B,D + ASH B,-11 ;RANGE = +,-16. + MOVE B,FCOLOR(B) + CONO CSCOP,(B) + MOVE B,FLOCAT(A) + MOVEI P,400(B) ;HACK TO MAKE BOTTOM OF FLAME FIXED + ANDI P,377 + IMUL C,P + ASH C,-16 + ADD B,C + ANDCMI D,777 + ADD B,D + DATAO CSCOP,B + AOBJN A,FLOOP + JRST FLOOP1 + +FANGLE: 600 + 600 + 0 + 400 +FPERIOD: 600 + 100 + 40 + 40 +FVELOC: 20 + 24 + 6 + 5 +FAMPL: 20 + 20 + 3 + 3 + + REPEAT 28.,BLUE + REPEAT 7,YELLOW +FCOLOR: REPEAT 6,YELLOW + ORANGE + RED + PINK + REPEAT 27.,WHITE + FLOCAT: 400427 + 400426 + 400424 + 401423 + 401422 + 401421 + 402420 + 402417 + 403416 + 404415 + 404414 + 405413 + 406412 + 406411 + 407410 + 407407 + 407406 + 407405 + 406404 + 406403 + 405402 + 404401 + 404402 + 403402 + 403401 + 402400 + 401400 + 400400 + 377400 + 376400 + 376401 + 377401 + 400401 + 401401 + 402401 + 402402 + 401402 + 400402 + 377402 + 376402 + 375402 + 375401 + 374401 + 374402 + 373402 + 372403 + 373403 + 374403 + 375403 + 376403 + 377403 + 400403 + 401403 + 402403 + 403403 + 404403 + 405403 + 405404 + 404404 + 403404 + 402404 + 401404 + 400404 + 377404 + 376404 + 375404 + 374404 + 373404 + 372404 + 371405 + 372405 + 373405 + 374405 + 375405 + 376405 + 377405 + 400405 + 401405 + 402405 + 403405 + 404405 + 405405 + 406405 + 406406 + 405406 + 404406 + 403406 + 402406 + 401406 + 400406 + 377406 + 376406 + 375406 + 374406 + 373406 + 372406 + 371406 + 371407 + 372407 + 373407 + 374407 + 375407 + 376407 + 377407 + 400407 + 401407 + 402407 + 403407 + 404407 + 405407 + 406407 + 406410 + 405410 + 404410 + 403410 + 402410 + 401410 + 400410 + 377410 + 376410 + 375410 + 374410 + 373410 + 372410 + 371410 + 372411 + 373411 + 374411 + 375411 + 376411 + 377411 + 400411 + 401411 + 402411 + 403411 + 404411 + 405411 + 405412 + 404412 + 403412 + 402412 + 401412 + 400412 + 377412 + 376412 + 375412 + 374412 + 373412 + 372412 + 373413 + 374413 + 375413 + 376413 + 377413 + 400413 + 401413 + 402413 + 403413 + 404413 + 403414 + 402414 + 401414 + 400414 + 377414 + 376414 + 375414 + 374414 + 374415 + 375415 + 376415 + 377415 + 400415 + 401415 + 402415 + 403415 + 402416 + 401416 + 400416 + 377416 + 376416 + 375416 + 376417 + 377417 + 400417 + 401417 + 401420 + 400420 + 377420 + 376420 + 377421 + 400421 + 400422 + 377422 + 377423 + 400423 + 400425 + ;TITLE LIGHTNING +;USES WIREF'S PDL (20 SEEMS JUST ENOUGH AFTER MOBY RUN OF THIS PROGRAM) + +LIGHT: MOVE U,[11060471625] + CONO CSCOP,313777 +DONE: RANDT + TLZ T,777774 + SOJG T,. + MOVEI P,PDL-1 + RANDT + ANDI T,377177 + MOVEI A,200500(T) + MOVE B,A +SPLIT: PUSH P,A +LLOOP2: RANDT + ANDI T,37 + XCT TAB(T) + MOVSI C,-2 +LLOOP1: ADD A,T + MOVEI A,(A) + TRNN A,600 + JRST DONE + DATAO CSCOP,A + MOVEI D,24 + SOJG D,. + AOBJN C,LLOOP1 + JRST LLOOP2 + +DIE: POP P,A + CAIE A,(B) + JRST LLOOP2 + JRST SPLIT + +TRY: CAIE A,(B) + JRST SPLIT + JRST LLOOP2 + TAB: JRST DIE + JRST TRY + MOVEI T,777 + MOVEI T,777 + MOVEI T, 2000 + MOVEI T, 2000 + MOVEI T, 1000 + MOVEI T, 1000 + MOVEI T,777000 + MOVEI T,777000 + MOVEI T,776000 + MOVEI T,776000 + MOVEI T, 1777 + MOVEI T, 1777 + MOVEI T, 777 + MOVEI T, 777 + MOVEI T,777777 + MOVEI T,777777 + MOVEI T,776777 + MOVEI T,776777 + MOVEI T,775777 + MOVEI T,775777 + MOVEI T, 1776 + MOVEI T, 1776 + MOVEI T, 776 + MOVEI T, 776 + MOVEI T,777776 + MOVEI T,777776 + MOVEI T,776776 + MOVEI T,776776 + MOVEI T,775776 + MOVEI T,775776 + ;TITLE STAR TREK +;USES 400 WORDS OF OCEAN'S SINTAB + +STREK: MOVE U,[11060471625] + SETOM XTAB + MOVE A,[XTAB,,XTAB+1] + BLT A,DELY+77 + MOVSI A,-400 + MOVEI B,0 + MOVEI C,200000 +STREK6: MOVE D,B + IMULI D,33 + ASH D,-12 + ADDB D,C + IMULI D,33 + ASH D,-12 + SUBB B,D + ASH D,-10 + MOVNM D,SINTAB(A) + AOBJN A,STREK6 +STREK2: MOVSI A,-100 +STREK1: HLRZ D,XTAB(A) + HLRZ E,YTAB(A) + SUBI D,40 + SUBI E,40 + IMUL D,D ;<2000 + IMUL E,E + ADDB D,E ;<4000 + IMUL D,SAVED(A) ;<100000 + LSH D,-13 ;<20 + MOVE D,@STCOLR(A) + CONO CSCOP,(D) + LSH E,-4 ;<200 + ADDI E,2 ;>0 + MOVE B,DELX(A) + IMUL B,E + ADDB B,XTAB(A) + JUMPL B,STREK3 + CAML B,[100,,0] + JRST STREK3 + MOVE C,DELY(A) + IMUL C,E + ADDB C,YTAB(A) + JUMPL C,STREK3 + CAML C,[100,,0] + JRST STREK3 + LSH B,-17 + LSH C,14 + LSHC B,11 + DATAO CSCOP,B + MOVEI B,24 + SOJG B,. +STREK5: AOBJN A,STREK1 + JRST STREK2 + +;SINE TABLE MAX = 400 +;INITIAL VELOCITY VARIANCE = 1-20 +;VELOCITY VARIANCE WITH POSITION = 1-10 +;MAX DATAO DEFLECTION = 1000 +;MAXIMUM IN XTAB AND YTAB TABLES = 100,,0 + STREK3: RANDT + MOVE B,T + LSHC B,-20. ;COLOR + LSH C,-16. + LSHC C,-12. ;DIRECTION & INITIAL DISPLACEMENT (8 BITS) + LSH D,-24. + LSHC D,-8. + MOVEM D,SAVED(A) ;VELOCITY SCALE (4 BITS) + AOS SAVED(A) + LSH E,-22. + ANDI E,37700 ;INITIAL DISPLACEMENT SCALE (8 BITS) + MOVE T,SINTAB(C) + IMULI T,3(D) + MOVEM T,DELX(A) + MOVE T,SINTAB(C) + IMUL T,E + ADD T,[40,,0] + MOVEM T,XTAB(A) + ADDI C,100 + ANDI C,377 + MOVE T,SINTAB(C) + IMULI T,3(D) + MOVEM T,DELY(A) + MOVE T,SINTAB(C) + IMUL T,E + ADD T,[40,,0] + MOVEM T,YTAB(A) + IDIVI B,3 + MOVE C,STCOL1(C) + MOVEM C,STCOLR(A) + JRST STREK5 + +XTAB: BLOCK 100 +YTAB: BLOCK 100 +DELX: BLOCK 100 +DELY: BLOCK 100 +STCOLR: BLOCK 100 +SAVED: BLOCK 100 + STCOL1: STRED(D) + STGRN(D) + STBLU(D) + +STRED: 220000 ;FAINT + 220000 + 220000 + 230000 + 240000 + 250000 + 260000 + 270000 + 300000 + 310000 + 320000 + 330000 + 340000 + 350000 + 360000 + 370000 ;BRIGHT + +STGRN: 002000 + 002100 + 002200 + 002300 + 002400 + 002500 + 002600 + 002700 + 003000 + 003100 + 003200 + 003300 + 003400 + 003500 + 003600 + 003700 + +STBLU: 000023 ;000020 INVISIBLE + 000023 ;000021 INVISIBLE + 000023 ;000022 INVISIBLE + 000023 + 000024 + 000025 + 000026 + 000027 + 000030 + 000031 + 000032 + 000033 + 000034 + 000035 + 000036 + 000037 + ;TITLE SPIRAL +;USES 500 WORDS OF OCEAN'S SINTAB + +SPIRAL: MOVSI A,-500 ;SINE TABLE GENERATOR VIA CIRCLE ALGORITHM + MOVEI B, ;TUNED TO MAKE EXACTLY 1 CYCLE (0-0) IN 400 ITERATIONS + MOVEI C,100000 ;MIN = -100002, MAX = 77727 +SPIR1: MOVE D,B + IMULI D,311037 + ASH D,-26 + ADDB C,D + IMULI D,311037 + ASH D,-26 + SUBB B,D + ASH D,2 ;SCALING FOR THIS PROGRAM + MOVNM D,SINTAB(A) ;1.25 CYCLES, -400000<=VALUE<=400000 + AOBJN A,SPIR1 + MOVSI F,-201 +SPIR2: MOVSI E,-200 +SPIR3: MOVE C,A ;CIRCLE ALGORITHM + ASH C,-3 + ADDB B,C + ASH C,-3 + SUBB A,C + ASH C,-5 ;SPIRALIZER + ADDB A,C + MOVE D,B + ASH D,-5 + ADDB B,D + ADD C,[40,,0] ;DATAO FUDGING + ADD D,[40,,0] + LSH C,-17 + LSH D,14 + LSHC C,11 + DATAO CSCOP,C + MOVEI D,14 + SOJG D,. + MOVE D,SPCOL(F) ;COLOR + CONO CSCOP,(D) + AOBJN F,.+2 + MOVSI F,-201 + AOBJN E,SPIR3 + DATAI CSCOP,D ;ROTATION SPEED + ADDI T,(D) + ANDI T,377 + MOVE A,SINTAB(T) + MOVE B,SINTAB+100(T) + JRST SPIR2 + +SPCOL: REPEAT 13.,PINK + REPEAT 13.,RED + REPEAT 13.,ORANGE + REPEAT 13.,YELLOW + REPEAT 13.,YELGRN + REPEAT 13.,GREEN + REPEAT 13.,BLUGRN + REPEAT 13.,BLUE + REPEAT 13.,VIOLET + REPEAT 12.,WHITE + ;TITLE PSYCHOLOGY +;USES WIREF'S DEFINITIONS OF %A, %B, ETC. + +PSYCH: MOVE U,[11060471625] +PSYCH0: RANDT + ANDI T,377777 + ADDI T,377777 + SOJG T,. + RANDT + DATAI CSCOP,E + TRNN T,7 + JUMPE E,PSYCH1 + ANDI E,77 + MOVE A,T + IDIVI A,3 + MOVE A,B + ANDCMI T,777776 + TLNN T,3 + ADDI A,1(T) ;MAKE COLOR WRONG + CAIL A,3 + SUBI A,3 + MOVE A,PSYCHA(A) + CONO CSCOP,(A) + MOVE B,PSYCHB(B) + BLT B,PDISL+5 +PSYCH2: RANDT + MOVE D,T + ANDI D,377377 + ADDI D,117165 +PDIS1: MOVEI F,0 ;POINTER TO CURRENTLY INTERPRETED DISLIST ENTRY +PDIS2: SKIPGE C,PDISL(F) + JRST PDIS3 + MOVSI B,-7 ;SCANS INCREMENTAL Y +PCHAR1: MOVSI A,-5 ;SCANS INCREMENTAL X +PCHAR2: TLNE C,200000 + JRST PCHAR5 +PCHAR3: LSH C,1 + AOBJN A,PCHAR2 + AOBJN B,PCHAR1 + ADDI D,7000*3 ;DX = 7 * SIZE, DY = 0 + AOJA F,PDIS2 ;CHARACTER DONE + +PCHAR5: MOVEI T,(A) + LSH T,9 + IORI T,(B) + IMULI T,3 ;SIZE + ADD T,D + DATAO CSCOP,T + MOVEI T,24 + SOJG T,. + JRST PCHAR3 + PDIS3: XCT PDIS4(C) + AOJA F,PDIS2 + +PDIS4: JRST PDDONE + CONO CSCOP,RED + CONO CSCOP,GREEN + CONO CSCOP,BLUE + +PDDONE: SUBI D,7000*5*3 + SOJG E,PDIS1 + JRST PSYCH0 + +PSYCH1: MOVE B,[PSPCL,,PDISL] + BLT B,PDISL+7 + JRST PSYCH2 + +PSYCHA: RED + GREEN + BLUE + +PSYCHB: PRED,,PDISL + PGRN,,PDISL + PBLU,,PDISL + +PRED: 0 + %R + %E + %D + 0 + SETZ ;END OF LIST + +PGRN: %G + %R + %E + %E + %N + SETZ + +PBLU: %B + %L + %U + %E + 0 + SETZ + +PSPCL: SETZ 3 + %B + SETZ 2 + %R + %E + %E + %N + SETZ + +PDISL: BLOCK 10 + ;TITLE MUNCHING SQUARES A LA PDP-1 +;SEE PAGE 2 FOR DATA SWITCHES SETTINGS COMMENTS + +MUNCH: SETZB B,C + SETZB D,E +MUNCH2: DATAI CSCOP,A ;LAT (L.H. = TEST WORD) + CAME A,F + JRST MUNCH5 + HLLZS A ;L.H. OF A = AC + SKIPGE A ;MAKE ONE'S COMPLEMENT NUMBER INTO TWO'S COMPLEMENT + AOBJN A,.+1 + SKIPGE C ;L.H. OF C = LOCATION 0 + AOBJN C,.+1 + ADD A,C ;ADD (-0 GRONKING DOESN'T MAKE TW = 1 WORK) + SKIPGE A ;MAKE TWO'S COMPLEMENT NUMBER INTO ONE'S COMPLEMENT + SUBI A,3 + HLLZ C,A ;DAC + HLL B,A ;R.H. OF B = IO + ROT B,9 ;RCL 9S + HLL A,B + XOR A,C ;XOR + LDB T,[331100,,A] + LDB U,[331100,,B] ;STRANGELY WORKS TO TAKE L.H., DOESN'T TO TAKE R.H. + LSH T,9 + IORI T,(U) + DATAO CSCOP,T ;DPY + MOVEI U,10 + SOJG U,. +MUNCH3: SOJG E,MUNCH2 ;COUNTS POINTS +MUNCH4: MOVEI E,105 + AOBJN D,.+2 ;CYCLES THROUGH COLORS + MOVSI D,-11 + MOVE U,MUNCHC(D) + CONO CSCOP,(U) + JRST MUNCH2 + +MUNCH5: MOVEM A,F + MOVE T,F + ANDI T,77777 ;COLOR RATE, 100/L.H. FOR 1 CYCLE, 40/L.H. FOR TWO, ETC. + HRRM T,MUNCH4 + MOVEI T,(SOJG E,) + TRNE F,400000 ;1 = DON'T CHANGE COLOR + MOVEI T,(JRST) + HRLM T,MUNCH3 + JRST MUNCH + +MUNCHC: RED + ORANGE + YELLOW + YELGRN + GREEN + BLUGRN + BLUE + VIOLET + PINK + ;TITLE COLOR SCOPE TEST PATTERNS +;USES WIREF'S COLORS TABLE + +CIRCLE: CLEARB C,D ;FOR DISPLAYING COLORS +CIR: MOVE A,CIRX + ASH A,-4 + ADDB A,CIRY + ASH A,-4 + MOVNS A + ADDB A,CIRX + ADDI A,400000 + MOVE B,CIRY + ASH B,-9 + ADDI B,400 + ANDI A,777000 + IORI A,(B) + DATAO CSCOP,A + MOVEI A,24 + SOJG A,. + CAIE C,11 + AOJA C,CIR + MOVEI C, + AOS D + CAIN D,10. + MOVEI D, + MOVE A,COLORS(D) + CONO CSCOP,(A) + JRST CIR + +CIRX: 200000 +CIRY: 0 + +PLUS: DATAI CSCOP,C ;FOR CONVERGING SCOPE + MOVE A,C + TRZ A,404000 + TRO A,40 + CONO CSCOP,(A) ;KEYS SAME FORMAT AS RASTER + TLZ C,700000 + MOVEI A,400000 +PLUS1: DATAO CSCOP,A + HLRZ B,C + SOJG B,. + ADDI A,111 + TRNN A,1000 + JRST PLUS1 + MOVEI A,400 +PLUS2: DATAO CSCOP,A + HLRZ B,C + SOJG B,. + ADDI A,111000 + TRNE A,7000 + JRST PLUS2 + MOVEI A,400400 + DATAO CSCOP,A + HLRZ B,C + SOJG B,. + JRST PLUS + SQUARE: DATAI CSCOP,A ;FOR COMPARING COLORS + TRZ A,404000 + TRO A,40 + CONO CSCOP,(A) + MOVEI A,340240 +SQUAR1: DATAO CSCOP,A + MOVEI B,34 + SOJG B,. + ADDI A,4 + MOVE B,A + ANDI B,777 + CAIE B,344 + JRST SQUAR1 + ADDI A,3674 + CAIE A,444240 + JRST SQUAR1 + DATAI CSCOP,A + MOVSS A + TRZ A,404000 + TRO A,40 + CONO CSCOP,(A) + MOVEI A,340440 +SQUAR2: DATAO CSCOP,A + MOVEI B,34 + SOJG B,. + ADDI A,4 + MOVE B,A + ANDI B,777 + CAIE B,544 + JRST SQUAR2 + ADDI A,3674 + CAIE A,444440 + JRST SQUAR2 + JRST SQUARE + +RASTER: DATAI CSCOP,C ;FOR CONVERGING SCOPE + MOVE A,C + TRZ A,404000 + TRO A,40 + CONO CSCOP,(A) ;R. H. IS COLOR + TLZ C,700000 + MOVEI A, +RAST: DATAO CSCOP,A + HLRZ B,C + SOJG B,. ;L. H. IS DELAY, NORMALLY 120 + ADDI A,111 + MOVE B,A + ANDI B,777 + CAIE B,110 + JRST RAST + ADDI A,107670 + CAIG A,777777 + JRST RAST + MOVEI A,400400 + DATAO CSCOP,A + HLRZ B,C + SOJG B,. + JRST RASTER + CROSS: DATAI CSCOP,D ;FOR CONVERGING SCOPE + MOVE B,D + TRZ B,404000 + TRO B,40 + CONO CSCOP,(B) ;KEYS SAME FORMAT AS RASTER + TLZ D,770000 + MOVEI B,2 + MOVEI C,2000 +CROSS1: MOVEI A,400400 +CROSS2: DATAO CSCOP,A + HLRZ E,D + SOJG E,. + ADDI A,(B) + ADDI A,(C) + TRNE A,777 + JRST CROSS2 + MOVNS B + JUMPL B,CROSS1 + MOVNS C + JUMPL C,CROSS1 + JRST CROSS + +BOX: DATAI CSCOP,D ;FOR CONVERGING SCOPE + MOVE A,D + TRZ A,404000 + TRO A,40 + CONO CSCOP,(A) ;KEYS SAME FORMAT AS RASTER EXCEPT TOP BITS = SIZE + LDB A,[331000,,D] + TLZ D,777000 + MOVEM A,BOX5 + ADDI A,400 + IMULI A,1001 + CAIN A,400400 + JRST BOX3 + MOVSI B,-4 +BOX1: MOVE C,BOX5 +BOX2: XCT BOX4(B) + DATAO CSCOP,A + HLRZ E,D + SOJG E,. + SOJG C,BOX2 + AOBJN B,BOX1 + JRST BOX + +BOX3: DATAO CSCOP,A + HLRZ E,D + SOJG E,. + JRST BOX + +BOX4: SUBI A,2 + SUBI A,2000 + ADDI A,2 + ADDI A,2000 + +BOX5: 0 + ;TITLE CSCOPE KSCOPE +;USES WIREF'S PDL + +KSCOPE: MOVEI P,PDL-1 + MOVE RN2,RN1 + CLEARM KTAB ;BLACKNESS + MOVE A,[KTAB,,KTAB+1] + BLT A,KTAB+2*30*30-1 +KLOOP1: RANDU + TLNE U,3 + JRST SLIDE + MOVE A,U ;MAKE NEW TRIANGLE + IDIVI A,12 + MOVE B,COLORS(B) + MOVEM B,NCOLOR + IDIV A,KSIZE + MOVEM B,X1 + IDIV A,KSIZE + MOVEM B,Y1 + MOVSI A,-4 ;4 CO-ORDS OF OTHER POINTS +KLOOP2: RANDU + MOVE B,U + IDIV B,TSIZE ;TRIANGLE SIZE + TRNE B,1 + MOVNS C + XCT DISPL(A) + CAMGE C,KSIZE + SKIPGE C + JRST KLOOP2 ;POINT NO GOOD + MOVEM C,X2(A) ;2 OTHER POINTS + AOBJN A,KLOOP2 + + MOVE A,X1 + MOVE B,Y1 + MOVE C,X2 + MOVE D,Y2 + PUSHJ P,LINE + MOVE A,X2 + MOVE B,Y2 + MOVE C,X3 + MOVE D,Y3 + PUSHJ P,LINE + MOVE A,X3 + MOVE B,Y3 + MOVE C,X1 + MOVE D,Y1 + PUSHJ P,LINE + MOVE A,KSIZE ;SCANS X + MOVE C,NCOLOR + MOVE B,STSMO ;SCANS Y +FILIN1: HRL B,MSIZE ;SCAN A VERTICAL LINE +FILIN2: SKIPGE KTAB(B) + JRST FILIN3 + AOBJN B,FILIN2 + JRST FILIN6 ;NO FILL FOUND + +FILIN3: MOVEM B,FILINA ;FOUND A FILL +FILIN4: SKIPGE KTAB(B) ;GET FILL END + MOVEM B,FILINB + AOBJN B,FILIN4 + MOVE D,FILINA +FILIN5: MOVEM C,KTAB(D) ;DO FILLING + CAME D,FILINB + AOBJN D,FILIN5 +FILIN6: SOJG A,FILIN1 ;LINE COMPLETE + +SLIDE: HRLZ A,KSIZE + ADD A,[KTAB,,KTAB] + MOVE B,KSIZE + IMUL B,B + ADD B,STSMO + SUB B,KSIZE + MOVEI C,KTAB(B) + BLT A,KTAB(B) ;SLIDE COLORS 1 COLUMN + CLEARM (C) ;BLACKNESS + HRL A,C + HRRI A,1(C) + ADD C,KSIZE + BLT A,(C) + MOVN R,KSIZE ;SCANS X + HRLZS R +KLOOP4: MOVEI S, ;SCANS Y +KLOOP5: HRRZ A,R ;GET COLOR TABLE INDEX + HRRZ B,S + DATAI CSCOP,C ;FLOW OF FORMS + JUMPL C,TEST + TRNE C,2 ;UP OR DOWN + EXCH A,B ;YES + TRNN C,1 ;UP OR RIGHT + JRST NOTUR ;NO + MOVNI A,1(A) ;YES + ADD A,KSIZE +NOTUR: IMUL A,KSIZE + ADDI A,(B) + HRRZ A,KTAB(A) + JUMPE A,KLOOP7 ;BLACKNESS + CONO CSCOP,(A) + TRNN R,777777 + JRST CENTER + TRNE C,10 + JRST OCTNTS ;FOURFOLD SYMMETRY + HRRZ A,R ;GET SCOPE CO-ORDS + HRRZ B,S + FLOAT A + FLOAT B + FADR A,[2.0] ;1/2 RASTER SPACING + MOVE T,A + FMPR T,T + MOVE U,B + FMPR U,U + FADR T,U + PUSHJ P,SQRT + FDVR A,T + FDVR B,T + FSC T,2 ;RASTER SPACING BY FUDGING RADIUS + MOVSI C,-14 +KLOOP6: MOVE D,A ;12 SEGMENTS, 6 DIRECT AND 6 MIRRORED + FMPR D,XCOS(C) + MOVE E,B + FMPR E,XSIN(C) + FADR E,D + FMPR E,T + FADR E,[256.5] ;TRANSLATE AND ROUND + FIX E + MOVE D,A + FMPR D,YCOS(C) + MOVE E,B + FMPR E,YSIN(C) + FADR D,E + FMPR D,T + FADR D,[256.5] + FIX D + LSH F,9 + IOR F,E + DATAO CSCOP,F ;NO DELAY NEEDED + MOVE F ;FOR H-P SCOPE + AOBJN C,KLOOP6 + FMPR B,T + FADR B,[1.0] + FMPR A,T + FMPR A,[0.57735026] ;TAN 30 + CAMLE A,B + AOJA S,KLOOP5 +KLOOP7: AOBJN R,KLOOP4 + JRST KLOOP1 + OCTNTS: MOVSI A,-8 ;OCTANTS +KLOOP8: XCT GETX(A) + XCT GETY(A) + ASH B,13 + ADDI B,400000 + ASH C,2 + ADDI C,400 + IOR B,C + DATAO CSCOP,B + MOVE B + MOVEI C,50 + SOJG C,. + AOBJN A,KLOOP8 + CAIGE S,(R) + AOJA S,KLOOP5 + AOBJN R,KLOOP4 + JRST KLOOP1 + +GETX: MOVEI B,1(R) + MOVEI B,1(S) + MOVNI B,(S) + MOVNI B,1(R) + MOVNI B,1(R) + MOVNI B,1(S) + MOVEI B,(S) + MOVEI B,1(R) + +GETY: MOVEI C,(S) + MOVEI C,1(R) + MOVEI C,1(R) + MOVEI C,1(S) + MOVNI C,(S) + MOVNI C,1(R) + MOVNI C,1(R) + MOVNI C,1(S) + +; 3 2 2 2 1 1 1 OCTANT MAP +; 3 3 2 2 1 1 0 +; 3 3 3 2 1 0 0 +; 4 4 4 0 0 0 +; 4 4 5 6 7 7 7 +; 4 5 5 6 6 7 7 +; 5 5 5 6 6 6 7 + CENTER: DATAO CSCOP,[400400] + MOVEI F,50 + SOJG F,. + AOBJN R,KLOOP4 + +TEST: MOVN A,KSIZE + IMUL A,KSIZE + HRLZS A ;COLOR TABLE INDEX + MOVEI B,400400 + MOVE C,KSIZE +TEST1: HRRZ D,KTAB(A) + CONO CSCOP,(D) + SKIPE D + MOVE B + DATAO CSCOP,B + MOVEI D,60 + SOJG D,. + ADDI B,4 + SOJG C,TEST2 + ANDI B,777000 + ADDI B,4400 + MOVE C,KSIZE +TEST2: AOBJN A,TEST1 + JRST KLOOP1 + +DISPL: ADD C,X1 + ADD C,Y1 + ADD C,X1 + ADD C,Y1 + LINE: MOVEM A,LINEX ;CONNECT (,) TO (,) + MOVEM B,LINEY ;(,) INCLUDED, (,) NOT UNLESS SAME + SUB C,A + MOVEM C,LINEDX + SUB D,B + MOVEM D,LINEDY + MOVMS C + MOVMS D + CAMGE C,D + MOVE C,D + MOVEM C,LINED + CLEARM LINEI +LINE1: MOVE A,LINEDX + IMUL A,LINEI + IDIV A,LINED + MOVMS B + ASH B,1 + CAMGE B,LINED + JRST LINE2 + SKIPL LINEDX ;AOS OF MAGNITUDE + AOSA A + SOS A +LINE2: ADD A,LINEX + MOVE B,LINEDY + IMUL B,LINEI + IDIV B,LINED + MOVMS C + ASH C,1 + CAMGE C,LINED + JRST LINE3 + SKIPL LINEDY + AOSA B + SOS B +LINE3: ADD B,LINEY + IMUL A,KSIZE ;SETOM (,) + ADD A,B + ADD A,STSMO + SETOM KTAB(A) + AOS A,LINEI + CAMGE A,LINED + JRST LINE1 + POPJ P, + +LINEX: 0 ;X LINE ORIGIN +LINEY: 0 ;Y LINE ORIGIN +LINEDX: 0 ;DX ALONG LINE +LINEDY: 0 ;DY ALONG LINE +LINED: 0 ;MAX MAGNITUDE DX, DY +LINEI: 0 ;INDEX ALONG LINE + +;INDEX INTO GENERATION PART OF KTAB P(X,Y) = SIZE*X+Y+SIZE*(SIZE-OVERLAP) + SQRT: MOVEM T+1,TPOSAV + MOVMS T + JUMPLE T,SQ2 + ASHC T,-33 + SUBI T,201 + ROT T,-1 + HRRM T,SQ1 + LSH T,-43 + ASH T+1,-10 + FSC T+1,177(T) + MOVEM T+1,ST + FMP T+1,S1(T) + FAD T+1,S2(T) + MOVE T,ST + FDV T,T+1 + FAD T+1,T + FSC T+1,-1 + MOVE T,ST + FDV T,T+1 + FADR T,T+1 +SQ1: FSC T,0 +SQ2: MOVE T+1,TPOSAV + POPJ P, + +S1: 0.8125 + 0.578125 +S2: 0.302734 + 0.421875 + +ST: 0 +;TPOSAV: 0 ;USES SINE'S TPOSAV + ;X(I) = R (XCOS(I) COS THETA + YSIN(I) SIN THETA) +;Y(I) = R (YCOS(I) COS THETA + YSIN(I) SIN THETA) + +XCOS: 1.0 + 0.5 + 0.5 + -0.5 + -0.5 + -1.0 + -1.0 + -0.5 + -0.5 + 0.5 + 0.5 + 1.0 + +XSIN: 0 + 0.86602541 ;1/2 SQRT 3 + -0.86602541 + 0.86602541 + -0.86602541 + 0 + 0 + -0.86602541 + 0.86602541 + -0.86602541 + 0.86602541 + 0 + +YCOS: 0 + 0.86602541 + 0.86602541 + 0.86602541 + 0.86602541 + 0 + 0 + -0.86602541 + -0.86602541 + -0.86602541 + -0.86602541 + 0 + +YSIN: 1.0 + -0.5 + 0.5 + 0.5 + -0.5 + 1.0 + -1.0 + 0.5 + -0.5 + -0.5 + 0.5 + -1.0 + FILINA: 0 +FILINB: 0 + +NCOLOR: 0 ;COLOR OF NEW TRIANGLE +KSIZE: 30 ;CENTER TO EDGE SIZE OF DISPLAY +MSIZE: -30 ;MINUS SIZE +STSMO: 30*<30-0> ;SIZE TIMES +;OVERLAP IS BETWEEN GENERATION PART OF KTAB AND DISPLAY PART +TSIZE: 14 ;MAX SIZE OF TRIANGLES +X1: 0 ;TRIANGLE CO-ORDS +Y1: 0 +X2: 0 +Y2: 0 +X3: 0 +Y3: 0 + +;USES WIREF'S RN1, COLORS, PDL + +KTAB==XSPUR ;USES BLOCK IN WIREF +;KTAB: BLOCK 2*30*30 ;2***2 +; 0 + ;TITLE VERMIFORM WORMIFORM +;USES WIREF'S RN1, COLORS + +LENGTH==300 ;INITIAL LENGTH OF WORM +NSKPS==3 ;INITIAL NUMBER OF POINTS ALONG WORM TO SKIP FROM LIGHT TO LIGHT + +;DATAI 377700 = WORM LENGTH - 1, 77 = POINT SPACING ALONG WORM - 1 + +WORM: MOVE RN2,RN1 + DATAI CSCOP,A + MOVEM A,OLDSW + MOVSI G,-LENGTH +WLOOP1: SOSLE FTIME + JRST WLOOP2 + RANDU + MOVE A,U + LSHC A,-6 + LSH B,-36 + TRZE B,40 + MOVNS B + MOVEM B,FORCE + ANDI A,37 + ADDI A,10 + MOVMS B + LSH B,-1 + SUB A,B + MOVEM A,FTIME + +WLOOP2: MOVE C,FORCE + IMUL C,WY1 + ASH C,-7 + ADDB C,WX1 + MOVM A,WX0 + MOVNS A + IMUL A,WX0 + ASH A,-27 + ADD A,C + ADDB A,WX0 ;NEW X POSITION + IMUL C,FORCE + ASH C,-7 + MOVNS C + ADDB C,WY1 + MOVM B,WY0 + MOVNS B + IMUL B,WY0 + ASH B,-27 + ADD B,C + ADDB B,WY0 ;NEW Y POSITION + MOVE D,WX1 + IMUL D,D + IMUL C,C + ADD C,D + SUB C,SQSUM + ASH C,-16 + MOVM D,WX1 + CAMGE D,C + MOVE D,C + SUB D,C + SKIPGE WX1 + MOVNS D + MOVEM D,WX1 ;SERVO X VELOCITY + MOVM D,WY1 + CAMGE D,C + MOVE D,C + SUB D,C + SKIPGE WY1 + MOVNS D + MOVEM D,WY1 ;SERVO Y VELOCITY + + ASH B,-11 + ADDI B,400 + ANDI B,777 + ADDI A,400000 + ANDI A,777000 + IOR A,B ;DISPLAY WORD + DATAI CSCOP,B + CAMN B,OLDSW + JRST SWSAME + MOVEM B,OLDSW + LSHC B,-6 + LSH C,-36 + ANDI B,3777 + AOS B + AOS C + CAMLE C,B + MOVE C,B + HRRM B,WLOOP4 ;NEW LENGTH OF WORM + MOVNS B + HRRM B,SETLUP + HRRM C,WLOOP6 ;NEW NUMBER OF POINTS TO SKIP + HRRM C,WLOOP7 +SWSAME: SOSLE CTIME + JRST OLDCLR + RANDU + MOVE B,U + IDIVI B,12 + ANDI B,77 + ADDI B,3 + MOVEM B,CTIME + SKIPA B,COLORS(C) +OLDCLR: HLR B,DISTAB(G) ;USE OLD COLOR + AOBJN G,.+2 +SETLUP: MOVSI G,-LENGTH + HRRM A,DISTAB(G) + HRLM B,DISTAB(G) + HRRZ A,G +WLOOP3: MOVS B,DISTAB(A) + TRZ B,404000 + TRO B,40 + CONO CSCOP,(B) + DATAO CSCOP,DISTAB(A) +WLOOP6: SUBI A,NSKPS + JUMPL A,WLOOP4 + MOVEI B,53 + SOJG B,. + JRST WLOOP3 + +WLOOP4: ADDI A,LENGTH +WLOOP5: CAIG A,(G) + JRST WLOOP1 + MOVEI B,53 + SOJG B,. + MOVS B,DISTAB(A) + TRZ B,404000 + TRO B,40 + CONO CSCOP,(B) + DATAO CSCOP,DISTAB(A) +WLOOP7: SUBI A,NSKPS + JRST WLOOP5 + OLDSW: 0 ;OLD CONTENTS OF CONSOLE DATA SWITCHES +WX1: 2651 ;X VELOCITY +WX0: 0 ;X POSITION +WY1: 0 ;Y VELOCITY +WY0: 0 ;Y POSITION +SQSUM: 10,,0 ;SUM OF SQUARES OF VELOCITY, VALUE TO SERVO TO +FORCE: 0 ;FORCE NORMAL TO VELOCITY +FTIME: 0 ;DURATION OF FORCE +CTIME: 0 ;DURATION OF COLOR + +DISTAB==XSPUR ;USES BLOCK IN WIREF +;CONSTA +;DISTAB: BLOCK LENGTH + ;TITLE VISUAL NOISE +;WITH GOSPER XOR AND NELSON COLORING + +; TEST WORD -- ALL BITS USED IN EQV, XOR OF MAIN LOOP +; 177777 -- TIME BETWEEN COLOR CHANGES (IF ENABLED) +;77,,760000 -- RATE TO SEEWP EPSILON OF CIRCLE ALGORITHM + +VNOISE: CLEARM VTIME + CLEARM TIMTAB + MOVE A,[TIMTAB,,TIMTAB+1] + BLT A,TIMTAB+377 +VLOOP: MOVE C,A + MUL C,F + EQV C,E ;EQV WITH [200000,,0] IN ORIGINAL VISUAL NOISE + ADDB C,B + MUL C,F + XOR C,E ;NO XOR IN ORIGINAL VISUAL NOISE + ADDB C,A +;ORIGINAL VISUAL NOISE HAS ADDI F,-1 HERE, THEN X & Y ARE 1000 + TOP TEN BITS OF A & B +;NOISE IS TOP 6 BITS OF Y DEFLECTION, FINISHING ITS MAIN LOOP + LSH C,-11 + HLR C,B + LSH C,-11 + DATAO CSCOP,C + MOVEI D,20 + SOJG D,. + LDB D,[2000,,0+E] + JFCL SWCOLR ;CHANGE TO JRST FOR NO AUTO COLORING + LDB S,[160400,,0+C] + LSH C,-5 + DPB C,[40400,,0+S] ;SCREEN SECTOR (TOP 4 X & Y BITS) + AOS T,VTIME + TRNN T,-100 + CLEARM DTTAB(T) + EXCH T,TIMTAB(S) ;GET OLD TIME FOR THIS SECTOR + SUB T,VTIME + MOVMS T + CAIGE T,100 + AOS S,DTTAB(T) ;ANOTHER OF THIS DELTA TIME + CAIE S,400 + JRST NOTYET + HRRM T,NOTYET + HLLOS VTIME +NOTYET: MOVEI D,1 +SWCOLR: MOVEI C,100000 + IDIV C,D + ADDB C,G ;GUNCH G (COLOR) BY 100000/ + TRZ C,404000 + TRO C,202060 ;NO COLORS OFF + CONO CSCOP,(C) + LDB D,[151300,,0+E] + ADD F,D ;GUNCH F BY 77,,760000 BITS + CAML F,[20000,,0] ;F COUNTS UP TO THIS + MOVNS F + DATAI CSCOP,E + JRST VLOOP + VTIME: 0 +DTTAB==XSPUR ;USES BLOCK IN WIREF +TIMTAB==DTTAB+100 +;DTTAB: BLOCK 100 ;DTTAB + N HAS TIMES N POINTS NEEDED TO RETURN TO SAME SCREEN SECTOR +;TIMTAB: BLOCK 400 ;TIMTAB + N HAS LAST TIME POINT OCCURRED IN SCREEN SECTOR N + ;TITLE FILL SPACE + +SCURVY: CONO CSCOP,64 + DATAI CSCOP,G + MOVE B,G + ANDI B,17 + MOVEI C,2 + LSH C,(B) + SOS C + MOVEI B,777 + IDIV B,C + MOVEM B,NDOTS +T8: MOVEI F,0 + DATAO CSCOP,F + MOVEI A,1 +T0: MOVE B,A + MOVE D,G ;ORDER OF CURVE + ANDI D,17 + MOVEI E, +T1: LSHC B,-2 + LSH C,-42 + XCT T2(C) + XCT T3(C) +T5: SOJGE D,T1 + XCT T6(E) + MOVE C,NDOTS +T7: ADD F,E + DATAO CSCOP,F + MOVEI B,40 + SOJG B,. + SOJG C,T7 + DATAI CSCOP,B + CAMN B,G + AOJA A,T0 + JRST SCURVY + +T2: TRNE E,3 + TRNN E,3 + TRNN E,3 + JRST T4 + +T3: TRC E,10 ;00S + IOR E,C + IOR E,C + +T4: TRNE E,3 + TRC E,4 ;11S + TRNN E,3 + IOR E,C + JRST T5 + UP==1 +DOWN==777777 +RIGHT==1000 +LEFT==777000 + +T6: JRST T8 + MOVEI E,UP + MOVEI E,RIGHT + MOVEI E,DOWN + 0 + MOVEI E,LEFT + MOVEI E,DOWN + MOVEI E,RIGHT + 0 + MOVEI E,RIGHT + MOVEI E,UP + MOVEI E,LEFT + 0 + MOVEI E,DOWN + MOVEI E,LEFT + MOVEI E,UP + +NDOTS: 0 + ;TITLE MINSKYTRON + +MINX1==10 +MINX2==11 +MINX3==12 +MINY1==13 +MINY2==14 +MINY3==15 + +DEFINE OBJECT P,Q + MOVE A,MINX!P + ADD A,MINX!Q + ASH A,@ASHX!P + ADDB A,MINY!P + SUB A,MINY!Q + ASH A,@ASHY!P + SUBB MINX!P,A + MOVEI A,400000(MINX!P) + LSH A,9 + HRRI A,400000(MINY!P) + LSH A,-9 + CONO CSCOP,37_<*6>+40 + DATAO CSCOP,A + HLRZ A,B + SOJG A,. +TERMIN + MTRON: CONO CSCOP,40 + DATAI CSCOP,A + CAMN A,B + JRST WORK + MOVNI MINX1,20000 + MOVEI MINX2,0 + MOVEI MINX3,20000 + MOVEI MINY1,0 + MOVEI MINY2,40000 + MOVEI MINY3,0 + MOVE B,A + DPB A,[300,,ASHX1] + LSH A,-3 + DPB A,[300,,ASHX2] + LSH A,-3 + DPB A,[300,,ASHX3] + LSH A,-3 + DPB A,[300,,ASHY1] + LSH A,-3 + DPB A,[300,,ASHY2] + LSH A,-3 + DPB A,[300,,ASHY3] +WORK: OBJECT 1,2 + OBJECT 2,3 + OBJECT 3,1 + JRST MTRON + +ASHX1: 0,,-1 +ASHX2: 0,,-1 +ASHX3: 0,,-1 +ASHY1: 0,,-1 +ASHY2: 0,,-1 +ASHY3: 0,,-1 + ;TITLE COLORFORMS + +FORMS: MOVE U,[11060471625] + MOVEI A,400000 ;INITIAL VALUES + MOVEI B,400000 + MOVEI X,400000 + MOVEI Y,400000 + MOVEI Z, ;LEVEL + CONO CSCOP,WHITE + JRST FMAIN + +AOSLEV: MOVE R,SAVE1(Z) + XCT SAVE2(Z) + AOS Z + MOVE S,COLTAB-1(Z) + RANDT + TRNE T,1 + JRST SAMCOL ;COPY SAME COLOR AS PREVIOUS LEVEL UP + TRNE T,6 + JRST OLDCOL ;KEEP OLD COLOR OF THIS LEVEL + MOVE R,T ;GET A RANDOM NEW COLOR + IDIVI R,10. + MOVE S,COLORS(S) + SKIPA +OLDCOL: MOVE S,COLTAB(Z) +SAMCOL: MOVEM S,COLTAB(Z) + CONO CSCOP,(S) +FMAIN: RANDT + TRNE T,774000 + JRST OLDFCN +NEWFCN: ANDI T,3 + MOVE T,FCNLIS(T) + MOVEM T,FCN(Z) +OLDFCN: SKIPE FCN(Z) + JRST @FCN(Z) + JRST NEWFCN + +MAYBEX: RANDT + TRNE T,777 + JRST NOEX + RANDT + HLR R,T + ANDI R,17 + XCT EXTAB(R) +NOEX: CAIE Z,LEVELS-1 + JRST AOSLEV ;PUSH DOWN A LEVEL + HRR R,X + LSH R,11 + HRR R,Y + LSH R,-11 + DATAO CSCOP,R + JRST @FCN(Z) + +SOSLEV: CLEARM FCN(Z) + JUMPE Z,FMAIN + MOVE R,UNSAVE-1(Z) + BLT R,G + SOJA Z,FMAIN + FLINE: HRRE D,A ;DX + HRRE E,B ;DY + MOVM F,D + MOVM B,E + CAMGE F,B + MOVE F,B ;POINTS + MOVEI G, ;INDEX + MOVEI A,FLINE1 + MOVEM A,FCN(Z) + CLEARB A,B + JRST MAYBEX + +FLINE1: SUB X,A + SUB Y,B + ADDI G,4321 + CAMLE G,F + JRST SOSLEV + MOVE A,D + IMUL A,G + IDIV A,F + ADD X,A + MOVE B,E + IMUL B,G + IDIV B,F + ADD Y,B + JRST MAYBEX + FBOX: HRRZ C,B + LSH C,-6 + ADDI C,1000 ;SPACING + MOVN D,C + HRRZS A + MOVE B,A + MOVE E,A ;SIZE + ADD X,A + ADD Y,B + MOVEI F,FBOX1 + MOVEM F,FCN(Z) + MOVEI F, ;SIDE INDEX + JRST MAYBEX + +FBOX1: SUB X,A + SUB Y,B +FBOX2: XCT FBOXX(F) + MOVM G,@FBOXX(F) + CAMG G,E + JRST FBOX3 + EXCH C,D + XCT FBOXX(F) ;UNDO EXTRA STEP + EXCH C,D + AOJA F,FBOX2 + +FBOX3: ADD X,A + ADD Y,B + JRST MAYBEX + +FBOXX: ADDM D,A + ADDM D,B + ADDM C,A + ADDM C,B + JRST SOSLEV + CIRCL: MOVEI C,CIRC1 + MOVEM C,FCN(Z) + HRRZS A + LSH A,-1 + ADDI A,3000 ;RADIUS + ADD X,A + MOVE C,B + ANDI C,77777 + ADDI C,4000 ;SPEED + MOVEI B, + JRST MAYBEX + +CIRC1: SUB X,A + SUB Y,B + MOVN D,B + IMUL D,C + ASH D,-22 + ADDB A,D + IMUL D,C + ASH D,-22 + EXCH B,D + ADD B,D + ADD X,A + ADD Y,B + JUMPL A,MAYBEX + JUMPL B,MAYBEX + JUMPGE D,MAYBEX + SUB X,A + SUB Y,B + JRST SOSLEV + BURST: ADD A,B + LSH A,-17 + ANDI A,7 + SOS C,A ;SCALE + MOVEI A,BURST1 + MOVEM A,FCN(Z) + MOVSI D,-<<2*6+1>*<2*6+1>> ;INDEX + CLEARB A,B + JRST MAYBEX + +BURST1: SUB X,A + SUB Y,B + AOBJP D,SOSLEV + HLRE A,BURSTT(D) + ASH A,(C) + ADD X,A + HRRE B,BURSTT(D) + ASH B,(C) + ADD Y,B + JRST MAYBEX + +BURSTT: 0 + REPEAT 6,[RPCNT==.RPCNT + 1000_,,0 + -1000_,,0 + 0,,1000_ + 0,,-1000_ +REPEAT 6,[1000_,,1000_<.RPCNT> + 1000_,,-1000_<.RPCNT> + -1000_,,-1000_<.RPCNT> + -1000_,,1000_<.RPCNT> +]] + LEVELS==3 + +FCN: BLOCK LEVELS + + WHITE +COLTAB: 300000 + 3000 + 30 + +FCNLIS: FLINE + FBOX + CIRCL + BURST + +EXTAB: EXCH A,B + EXCH A,X + EXCH A,Y + EXCH B,X + EXCH B,Y + EXCH X,Y + HRRZ A,T + HRRZ B,T + HRRZ X,T + HRRZ Y,T + MOVEI X,400000 + MOVEI Y,400000 +REPEAT 4,JFCL + +SAVE1: REPEAT LEVELS-1,A,,ACSAVE+7*.RPCNT + +SAVE2: REPEAT LEVELS-1,BLT R,ACSAVE+6+7*.RPCNT + +UNSAVE: REPEAT LEVELS-1,ACSAVE+7*.RPCNT,,A + +ACSAVE: BLOCK 7* + +FPATCH: BLOCK 40 + +END +  \ No newline at end of file