perm filename GEOMES[GEM,BGB] blob
sn#032395 filedate 1973-03-30 generic text, type T, neo UTF8
00100 TITLE GEOMES - GEOMETRIC MODELING EMBEDDED IN SAIL - BGB 1973.
00200 ;-----------------------------------------------------------------
00300 ;AD HOC TOP LEVEL OF GEOMES - TEMPORARY VERSION FOR RUSS TAYLOR.
00400 INTERN UNIVER,BLKCNT,AVAIL,CAMERA
00500 UNIVER: 0 ;POINTER TO THE UNIVERSE NODE.
00600 BLKCNT: 0 ;NUMBER OF NODES IN USE.
00700 AVAIL: 0 ;POINTER TO EMPTY NODE LIST.
00800 NODSIZ←←=12 ;NUMBER OF WORDS PER NODE.
00900 CAMERA:0↔WINDOW:0 ;WHICH ARE HERE AND SHOULDN'T BE.
01000
01100 SUBR(MKNODE)TYPE--------------------------------------------------
01200 BEGIN MAKE; ALLOCATE A BLOCK OF NODSIZ WORDS - BGB - 4 DEC 1972.
01300 SKIPE AVAIL
01400 SKIPN 1,@AVAIL↔CALL(MORCOR)
01500 CDR -3(1)↔DAP @AVAIL
01600 DZM -3(1)↔AOS @BLKCNT
01700 POP P,.+3↔POP P,(1)↔GO @.+1↔0
01800 BEND;1/12/73------------------------------------------------------
01900
02000 SUBR(KLNODE)NODE--------------------------------------------------
02100 BEGIN KILL; - RELEASE BLOCK OF NODSIZ WORDS - BGB - 4 DEC 1972.
02200 LAC 1,ARG1
02300 SOS @BLKCNT
02400 LIPI -3(1)↔LAPI -2(1)
02500 SETZM -3(1)↔BLT 8(1) ;CLEAR NODE.
02600 LAC@AVAIL↔DAPZ -3(1)
02700 DAPZ 1,@AVAIL
02800 POP1J
02900 BEND;1/12/73------------------------------------------------------
00100 SUBR(MORCOR)------------------------------------------------------
00200 BEGIN MORCOR; - GET MORE CORE FROM SAIL - BGB - 8 MARCH 1972.
00300 EXTERN CORGET
00400
00500 PUSH P,2↔PUSH P,3
00600 SETZ 2,
00700 L1: LACI 3,NODSIZ*=400 ;AC3 SIZE OF SPACE.
00800 CALL(CORGET) ;AC2 ADDRESS OF SPACE.
00900 GO[FATAL(NO MORE CORE.)]
01000 SLACI(2)↔LAPI 1(2)↔DZM(2)
01100 BLT NODSIZ*=400-1(2) ;CLEAR BLOCK OF MEMORY.
01200 LACI 1,3(2) ;ORIGIN OF FIRST NODE.
01300
01400 ;INITIALIZE THE UNIVERSE WHEN NECESSARY.
01500 SKIPE UNIVER↔GO L3
01600 LACI -2(1)↔DAC AVAIL ;POINTER TO AVAIL LIST.
01700 LACI -1(1)↔DAC BLKCNT ;POINTER TO NODE COUNT.
01800 DAC 1,UNIVERSE ;POINTER TO UNIVERSE NODE.
01900
02000 ;MAKE AVAIL LIST.
02100 L3: DIP 1,1
02200 ADD 1,[XWD NODSIZ,0]
02300 SKIPN@BLKCNT↔GO[
02400 ADD 1,[XWD NODSIZ,NODSIZ] ;STEP OVER UNIVERSE.
02500 AOS@BLKCNT↔SUBI 3,NODSIZ↔GO .+1]
02600 SUBI 3,NODSIZ
02700 DAPZ 1,@AVAIL
02800
02900 ;PLACE EACH NEW EMPTY BLOCK ON THE AVAIL LIST.
03000 L2: HLRZM 1,-3(1) ;EMPTY LIST POINTER.
03100 ADD 1,[XWD NODSIZ,NODSIZ]
03200 SUBI 3,NODSIZ
03300 JUMPN 3,L2
03400
03500 LAC 1,@AVAIL
03600 POP P,3↔POP P,2
03700 POP0J
03800
03900 BEND;1/12/73------------------------------------------------------
00100 ;III DISPLAY SUBROUTINES-BGB-JANUARY 1973----------------------
00200 A←1↔B←2↔C←3
00300 INTERN BUFDPY↔BUFDPY:.+2↔=100↔BLOCK =100
00400 INTERN DPYBUF↔DPYBUF:DPYBU.↔=2048 ↔ DPYBU.: BLOCK =2048
00500 IGNORE:0↔DPYPTR:0↔BUFEND:0
00600 BUFHD:0↔0;UPG ARGUMENT. ;ADDRESS ↔ LENGTH.
00700 ;--------------------------------------------------------------
00800 INTERN DPYSET,DPYOUT,DPYBRT,AIVECT,AVECT,DPYSTR,DTYO,DPYBIG
00900 DPYSET: LAC 1,ARG1↔CDR 2,-1(1) ;BUFFER SIZE.
01000 ADDI 2,-1(1)↔DAC 2,BUFEND
01100 ADDI 1,2↔DAC 1,BUFHD ;POINT TO THIRD WORD.
01200 SETZM IGNORE
01300 CLR2: LAC A,BUFHD↔LACI B,1↔DAC B,1(A)
01400 LACI B,2(A)↔LIPI B,1(A)↔BLT B,@BUFEND
01500 PUSH P,(P)↔GO LV3
01600 ;--------------------------------------------------------------
01700 DPYBIG: SKIPE IGNORE↔POP1J
01800 LAC A,ARG1↔LACI C,46↔DPB A,[POINT 3,3,27]
01900 PUSH P,(P)↔GO LV2
02000
02100 DPYBRT: SKIPE IGNORE↔POP1J
02200 LAC 1,ARG1↔LACI C,46↔DPB A,[POINT 3,3,24]
02300 PUSH P,(P)↔GO LV2
02400 ;--------------------------------------------------------------
02500 AIVECT: SKIPA C,[146] ;INVISIBLE ABSOLUTE.
02600 AVECT: LACI C,106
02700 SKIPGE IGNORE↔POP2J
02800 LV: LAC A,ARG2↔LAC B,ARG1
02900 LVC: DPB A,[POINT 11,C,10]
03000 DPB B,[POINT 11,C,21]
03100 LV2: AOS A,DPYPTR↔DAC C,(A)
03200 LV3: LIPI A,<(<POINT 7,0,35>)>
03300 DAC A,DPYPTR↔LACI A,(A)
03400 CAML A,BUFEND↔SETOM IGNORE
03500 POP2J
03600 ;--------------------------------------------------------------
03700 DPYSTR: LAC 3,ARG1↔LIPI 3,440700
03800 ILDB 3↔JUMPE POP1J.
03900 CALL(DTYO,0)↔GO DPYSTR+2
04000
04100 DTYO: LAC 1,ARG1↔IDPB 1,DPYPTR
04200 CDR 1,DPYPTR↔CAML 1,BUFEND
04300 SETOM IGNORE↔POP1J
04400 ;--------------------------------------------------------------
04500 DPYOUT: SKIPN 1,BUFHD↔GO .+6
04600 LAC 2,DPYPTR↔DAC 2,-2(1)
04700 LACI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
04800 CDR B,DPYPTR↔SUB B,BUFHD
04900 AOS B↔DAC B,BUFHD+1
05000 LAC 1,ARG1↔DPB A,[POINT 4,.+1,12]↔703B8+BUFHD
05100 POP1J
05200 ;--------------------------------------------------------------
00100 SUBR(DECDPY)NUMBER------------------------------------------------
00200 BEGIN DECDPY;DECIMAL NUMBER DISPLAY - BGB - 17 DEC 1972.
00300 LAC 1,ARG1↔POP P,ARG1 ;GET ARG AND ADJUST STACK.
00400 L1: JUMPGE 1,L2 ;TEST FOR NEGATIVE NUMBER.
00500 MOVM 2,1↔CALL(DTYO,["-"]) ;PRINT MINUS SIGN.
00600 LAC 1,2
00700 L2: IDIVI 1,12↔PUSH P,2 ;MODULO TEN AND SAVE.
00800 SKIPE 1↔PUSHJ P,L2 ;TEST FOR DONE.
00900 POP P,1↔ADDI 1,60↔CALL(DTYO,1) ;RESTORE & PRINT.
01000 POP0J
01100 BEND;12/17/72-----------------------------------------------------
01200
01300 SUBR(FLODPY)FLONUM,PLACES-----------------------------------------
01400 BEGIN FLODPY;FLOATING NUMBER DISPLAY - BGB - 4 FEB 1973.
01500 LAC ARG2↔JUMPL[CALL(DTYO,["-"])↔LACM ARG2↔GO .+1]
01600 LACM 2,ARG1↔CAILE 2,6↔LACI 2,6↔DAC 2,ARG1
01700 FMPR[1.↔10.↔100.↔1000.↔10000.↔100000.↔1000000.](2)↔FIXX
01800 IDIV[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
01900 PUSH P,1↔CALL(DECDPY,0)↔POP P,0↔LAC 2,ARG1
02000 ADD[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
02100 PUSH P,DPYPTR↔CALL(DECDPY,0)↔POP P,1
02200 LACI "."↔IDPB 0,1↔POP2J↔LIT
02300 BEND;2/4/73-------------------------------------------------------
00100 SUBR(IIIDPY)WINDOW,GLASS -----------------------------------------
00200 BEGIN IIIDPY; DISPLAY DEVICE ROUTINE.
00300 E←←16
00400
00500 ;DISPLAY WINDOW FRAME.
00600 LAC 1,ARG2
00700 NIP 1(1)↔DAC XL
00800 NAP 1(1)↔DAC XH
00900 NIP 2(1)↔DAC YL
01000 NAP 2(1)↔DAC YH
01100 CALL(DPYSET,DPYBUF)
01200 CALL(AIVECT,XL,YL)
01300 CALL(AVECT,XH,YL)
01400 CALL(AVECT,XH,YH)
01500 CALL(AVECT,XL,YH)
01600 CALL(AVECT,XL,YL)
01700
01800 ;DISPLAY THE VISIBLE EDGE LIST.
01900 LAC E,ARG2
02000 ALT2 E,E↔JUMPE E,L2 ;GET THE WORLD.
02100 PED E,E↔SKIPA ;FIRST EDGE OF WORLD.
02200 L1: ALT2 E,E↔JUMPE E,L2 ;GET AN EDGE.
02300 X1DC 1,E↔Y1DC 2,E↔CALL(AIVECT,1,2)
02400 X2DC 1,E↔Y2DC 2,E↔CALL(AVECT,1,2)
02500 GO L1
02600
02700 L2: CALL(DPYOUT,ARG1)
02800 POP2J
02900
03000 DECLARE{XL,XH,YL,YH}
03100 BEND IIIDPY; BGB 5 FEB 1973 --------------------------------------
00100 ;VERNIER III TEXT POSITIONING.
00200 VERNX ←← 14
00300 VERNY ←← 11
00400 SUBR(VDPY)V-------------------------------------------------------
00500 BEGIN VDPY;SPECIAL VERTEX DISPLAY - BGB - 9 JANUARY 1973.
00600 LAC 1,ARG1↔CAR 0,(1)↔ANDI 0,017400 ;NSEW & PZZ.
00700 SKIPE↔POP1J
00800 XDC 0,1↔FIXX↔SUBI VERNX↔PUSH P,0
00900 YDC 0,1↔FIXX↔SUBI VERNY↔PUSH P,0↔PUSHJ P,AIVECT
01000 CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
01100 CALL(IDPY,ARG1)
01200 CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
01300 POP1J
01400 BEND;2/9/73-------------------------------------------------------
01500
01600 SUBR(EDPY)E-------------------------------------------------------
01700 BEGIN EDPY;SPECIAL EDGE DISPLAY - BGB - 9 FEBRUARY 1973.
01800 CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
01900 LAC 2,ARG1
02000 PVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L1
02100 XDC 0,1↔FIXX↔DAC X↔PUSH P,0
02200 YDC 0,1↔FIXX↔DAC Y↔PUSH P,0
02300 PUSH P,ARG1↔PUSH P,ARG1
02400 PUSHJ P,AIVECT
02500 CALL(DTYO,["+"])↔CALL(AIVECT)
02600 L1: LAC 2,ARG1
02700 NVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L2
02800 XDC 0,1↔FIXX↔ADDM X↔PUSH P,0
02900 YDC 0,1↔FIXX↔ADDM Y↔PUSH P,0↔PUSHJ P,AVECT
03000 CALL(DTYO,["-"])
03100 L2: LAC 2,ARG1
03200 LAC X↔ASH -1↔PUSH P,0
03300 LAC Y↔ASH -1↔PUSH P,0
03400 CALL(AIVECT)↔CALL(IDPY,ARG1)
03500 CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
03600 POP1J
03700 DECLARE{X,Y}
03800 BEND;2/9/73-------------------------------------------------------
03900
00100 SUBR(FDPY)F-------------------------------------------------------
00200 BEGIN FDPY;SPECIAL FACE DISPLAY - BGB - 9 FEBRUARY 1973.
00300 EXTERN ECCW
00400 LAC 1,ARG1↔DAC 1,F
00500 TEST 1,FBIT↔POP1J
00600 PED 2,1↔DAC 2,E↔DAC 2,E0
00700 SETZM I
00800 CALL(DPYBIG,[1])
00900 CALL(DPYBRT,[3])
01000 SKIPN E↔GO[LAC 1,F↔PFACE 1,1↔PVT 1,1↔GO VDPY+1]
01100 L1: AOS I↔LAC 2,E↔TEST 2,VISIBLE↔GO L2
01200 X1DC 0,2↔DAC 0,X
01300 Y1DC 1,2↔DAC 1,Y
01400 CALL(AIVECT,0,1)↔LAC 2,E
01500 X2DC 0,2↔ADDM 0,X
01600 Y2DC 1,2↔ADDM 1,Y
01700 CALL(AVECT,0,1)
01800 LAC 0,X↔ASH 0,-1↔SUBI 0,VERNX
01900 LAC 1,Y↔ASH 1,-1↔SUBI 1,VERNY
02000 CALL(AIVECT,0,1)
02100 CALL(DECDPY,I)
02200 L2: CALL(ECCW,E,F)
02300 CAMN 1,E↔GO L3↔DAC 1,E
02400 CAME 1,E0↔GO L1
02500 L3: CALL(DPYBRT,[2])
02600 CALL(DPYBIG,[2])
02700 POP1J
02800 DECLARE{F,E,E0,X,Y,I}
02900 BEND;2/9/73-------------------------------------------------------
00100 SUBR(IDPY)NODE----------------------------------------------------
00200 BEGIN IDPY; IDENTIFIER DISPLAY.
00300 EXTERN CAMERA
00400 LAC 1,ARG1↔SETZ 2,
00500 TESTZ 1,BBIT↔GO[
00600 SKIPE 4(1)↔GO[SETZ↔ALT. 0,1↔LACI 4(1)
00700 CALL(DPYSTR,0)↔GO L1A]
00800 L1: CW 1,1↔TESTZ 1,BBIT↔AOJA 2,L1
00900 AOS 2↔PUSH P,2↔CALL(DTYO,["B"])
01000 CALL(DECDPY)
01100 L1A: SETZB 14,15↔LAC 1,ARG1
01200 TESTZ 1,BDLBIT↔IORI 14,4
01300 TESTZ 1,BDVBIT↔IORI 14,2
01400 TESTZ 1,BDPBIT↔IORI 14,1
01500 JUMPE 14,POP1J.
01600 LAC 14,[
01700 0↔ASCII/.P./↔ASCII/.V./↔ASCII/.VP./
01800 ASCII/.L./↔ASCII/.LP./
01900 ASCII/.LV./↔ASCII/.LVP./](14)
02000 CALL(DPYSTR,[14])↔POP1J]
02100 TESTZ 1,FBIT↔GO[
02200 L2: NFACE 1,1↔TESTZ 1,FBIT↔AOJA 2,L2
02300 AOS 2↔PUSH P,2↔CALL(DTYO,["F"])
02400 CALL(DECDPY)↔POP1J]
02500 TESTZ 1,EBIT↔GO[
02600 L3: NED 1,1↔TESTZ 1,EBIT↔AOJA 2,L3
02700 AOS 2↔PUSH P,2↔CALL(DTYO,["E"])
02800 CALL(DECDPY)↔POP1J]
02900 TESTZ 1,VBIT↔GO[
03000 L4: NVT 1,1↔TESTZ 1,VBIT↔AOJA 2,L4
03100 AOS 2↔PUSH P,2↔CALL(DTYO,["V"])
03200 CALL(DECDPY)↔POP1J]
03300 CAMN 1,CAMERA↔GO[CALL(DPYSTR,{[[ASCIZ"CAMERA"]]})↔POP1J]
03400 CALL(DPYSTR,{[[ASCIZ"UNDEF"]]})
03500 POP1J
03600 LIT
03700 BEND;2/4/73-------------------------------------------------------
03800 END