General Information
Author: Clinton Parker
Language: ACTION!
Compiler/Interpreter: ACTION!
Published: April 13, 1983
Copyright 1983 by Action Computer Services last modified April 13, 1983
CIS Notice: I am providing the program for you to look at and maybe help you get started with ACTION!. It was written 'quick and dirty' and as such does not have many comments and is not the best of code in many places. Feel free to show it to anyone you like as long as you keep the copyright notice.
In case you are interested, this is the company logo for Action Computer Services (ACS).
- Clinton Parker 70435,625
PS: Hit ESC to exit program
; CIS Notice:
; I am providing the program for you
; to look at and maybe help you get
; started with ACTION!. It was
; written 'quick and dirty' and as
; such does not have many comments
; and is not the best of code in many
; places. Feel free to show it to
; anyone you like as long as you keep
; the copyright notice.
; In case you are interested, this is
; the company logo for Action
; Computer Services (ACS).
; - Clinton Parker 70435,625
; PS: Hit ESC to exit program
; Copyright 1983 by Action Computer Services
; last modified April 13, 1983
MODULE ; LOGO.ACT
DEFINE RTI = "$40",
PHA = "$48",
PLA = "$68",
TXA = "$8A",
TAX = "$AA",
TYA = "$98",
TAY = "$A8"
BYTE start
BYTE ARRAY display
CARD ARRAY yLoc(96)
PROC NMI()
BYTE color, cnt
BYTE COLPF1=$D017, WSYNC=$D40A,
VCOUNT=$D40B, COLPF2=$D018,
COLPF0=$D016
BYTE ARRAY col(0)=[$68 $C $96 $38]
[PHA TXA PHA TYA PHA]
IF VCOUNT=7 THEN
color = start
start = start - 1
IF (start&$1F)=0 THEN cnt = cnt + 1 FI
FI
color = color - 2
WSYNC = 1
COLPF0 = color
COLPF1 = color
COLPF2 = col((cnt + VCOUNT) & 3)
[PLA TAY PLA TAX PLA RTI]
PROC Background()
BYTE COLBK=$D01A, VCOUNT=$D40B, WSYNC=$D40A
[PHA TXA PHA TYA PHA]
WSYNC = 0
IF VCOUNT>50 THEN
COLBK = 0
ELSE
COLBK = $D6
FI
[PLA TAY PLA TAX PLA RTI]
PROC Init7()
BYTE i
CARD screen, scrloc=88
Graphics(23)
SetColor(0,2,10)
SetColor(1,0,12)
SetColor(2,0,12)
display = scrloc
screen = scrloc
i = 0
WHILE i<96 DO
yLoc(i) = screen
screen = screen + 40
i = i + 1
OD
RETURN
PROC Plot7(BYTE x, y)
BYTE ARRAY pos, bm(0)=[$C0$30$C$3],
cm(0)=[$0 $55 $AA $FF]
pos = yLoc(y)
pos(x RSH 2) ==% (bm(x&3)&cm(color))
RETURN
PROC VLine(BYTE x, y1, y2)
WHILE y1#y2 DO
Plot7(x, y1)
y1 = y1 + 1
OD
RETURN
PROC HLine(BYTE x1, x2, y)
WHILE x1#x2 DO
Plot7(x1, y)
x1 = x1 + 1
OD
RETURN
PROC DLine(BYTE x1, x2, y1)
BYTE incr
incr = 1
IF x2<x1 THEN incr = $FF FI
WHILE x1#x2 DO
Plot7(x1, y1)
x1 = x1 + incr
Plot7(x1, y1)
y1 = y1 + 1
OD
RETURN
PROC Dot(BYTE x, y)
BYTE i
i = 0
WHILE i<4 DO
Plot7(x+1, y) Plot7(x+2, y)
IF i=1 OR i=2 THEN
Plot7(x, y) Plot7(x+3, y)
FI
y = y + 1
i = i + 1
OD
RETURN
PROC Pad(BYTE x, y)
BYTE i
i = 0
WHILE i<4 DO
Plot7(x, y)
Plot7(x+1, y)
Plot7(x+2, y)
y = y + 1
i = i + 1
OD
RETURN
PROC LineX(BYTE x1, y1, x2, y2)
Plot(x1, y1)
DrawTo(x2, y2)
Plot(x1+1, y1)
DrawTo(x2+1, y2)
RETURN
PROC LineY(BYTE x1, y1, x2, y2)
Plot(x1, y1)
DrawTo(x2, y2)
; Plot(x1, y1+1)
; DrawTo(x2, y2+1)
RETURN
PROC Curve(BYTE x, y)
; Plot7(x-1, y-1)
VLine(x, y-1, y+2)
VLine(x+1, y-1, y+2)
VLine(x+2, y-2, y+1)
y = y - 4
VLine(x+3, y, y+5)
VLine(x+4, y, y+4)
VLine(x+5, y, y+3)
Plot7(x+6, y)
Plot7(x+6, y+1)
RETURN
PROC Draw()
BYTE i, j, k
CARD x
; draw fingers
i = 0
x = 160
WHILE i<15 DO
j = 0
WHILE j<3 DO
k = 0
WHILE k<4 DO
display(x+k) = $55
k = k + 1
OD
x = x + 40
j = j + 1
OD
x = x + 120
i = i + 1
OD
; draw the pads
i = 64
WHILE i<112 DO
Pad(i, 22)
i = i + 6
OD
Pad(142, 22)
Pad(70, 62)
Pad(76, 62)
Pad(94, 62)
Pad(106, 62)
Pad(142, 62)
; finger 1, 15 connections
i = 0
WHILE i<4 DO
display(204+i) = $AA
display(3564+i) = $AA
i = i + 1
OD
Dot(31, 3)
Dot(29, 88)
; finger 2 connection (A3)
LineX(16, 11, 44, 8)
HLine(44, 105, 8)
DLine(105, 107, 8)
VLine(107, 10, 23)
; finger 3 connection (A2)
LineX(16, 17, 48, 11)
HLine(48, 99, 11)
DLine(99, 101, 11)
VLine(101, 13, 23)
; finger 4 connection (A1)
LineX(16, 23, 52, 14)
HLine(52, 93, 14)
DLine(93, 95, 14)
VLine(95, 16, 23)
; finger 5 connection (A0)
LineX(16, 29, 56, 17)
HLine(56, 87, 17)
DLine(87, 89, 17)
VLine(89, 19, 23)
; finger 6 connection (D4)
HLine(16, 60, 35)
LineY(60, 35, 71, 62)
; finger 7 connection (D5)
HLine(16, 56, 41)
DLine(56, 58, 41)
VLine(58, 43, 66)
DLine(58, 60, 66)
HLine(60, 76, 68)
DLine(77, 75, 66)
; finger 8 connection (D2)
HLine(16, 34, 47)
DLine(34, 58, 47)
HLine(58, 79, 71)
DLine(80, 78, 70)
VLine(80, 60, 70)
LineY(80, 60, 71, 25)
; finger 9 connection (D1)
HLine(16, 34, 53)
DLine(34, 55, 53)
HLine(55, 85, 74)
DLine(86, 84, 73)
VLine(86, 60, 73)
LineY(86, 60, 77, 25)
; finger 10 connection (D0)
HLine(16, 20, 59)
DLine(23, 19, 56)
HLine(24, 32, 56)
DLine(32, 53, 56)
HLine(53, 91, 77)
DLine(92, 90, 76)
VLine(92, 60, 76)
LineY(92, 60, 83, 25)
; finger 11 connection (D6)
HLine(16, 24, 65)
DLine(27, 23, 62)
Dot(26, 60)
; finger 12 connection (CS)
DLine(107, 92, 66)
HLine(50, 92, 80)
DLine(40, 50, 71)
HLine(16, 40, 71)
VLine(95, 66, 78)
; finger 13 connection (+5)
Plot(16, 76)
DrawTo(50, 86)
Plot(16, 77)
DrawTo(50, 87)
Plot(16, 78)
DrawTo(50, 88)
HLine(50, 149, 86)
HLine(50, 149, 87)
HLine(50, 149, 88)
Curve(149, 86)
i = 0
WHILE i<4 DO
VLine(153+i, 47, 82)
DLine(143+i, 153+i, 37)
VLine(143+i, 22, 37)
HLine(142, 155, 62+i)
VLine(153+i, 5, 17) ; ground pad
i = i + 1
OD
HLine(143, 146, 21)
Plot7(141, 63)
Plot7(141, 64)
Curve(149, 62)
HLine(149, 153, 66)
VLine(152, 66, 70)
Plot7(151, 67)
; finger 14 connection (cart. select)
HLine(16, 35, 82)
HLine(16, 38, 83)
HLine(16, 41, 84)
; ground pads
Dot(153, 3)
Dot(153, 16)
HLine(62, 64, 23)
HLine(62, 64, 24)
RETURN
PROC Letter(BYTE ARRAY pts, BYTE x, y, delay)
BYTE i, dx, dy
WHILE 1 DO
dx = pts^
pts = pts + 1
dy = pts^
pts = pts + 1
IF dx=$FF THEN EXIT FI
Plot7(x+dx, y+dy)
; i = 0
; WHILE i<delay DO i==+1*1*1 OD
OD
RETURN
PROC Logo()
CHAR CH=$2FC
BYTE x, NMIEN=$D40E, COLBK=$D01A
CARD j, old, SDLST=$230, VDSLST=$200
BYTE i
BYTE ARRAY dlist
BYTE ARRAY side(0)=[2 0 1 0 0 0 0 1
0 2 1 2 2 2 2 3 2 4 1 4 0 4 4 0 4
1 4 2 4 3 4 4 6 0 6 1 6 2 6 3 6 4
7 0 8 1 8 2 8 3 7 4 10 0 10 1 10
2 10 3 10 4 11 0 12 0 11 2 11 4 12
4 18 4 18 3 19 2 19 1 20 0 21 1 21
2 22 3 22 4 20 2 $FF]
BYTE ARRAY copyright(0)=[5 0 4 0 3 0
2 0 1 1 0 2 0 3 0 4 0 5 1 6 2 7 3
7 4 7 5 7 6 6 7 5 7 4 7 3 7 2 6 1
4 2 3 2 2 3 2 4 3 5 4 5 $FF]
BYTE ARRAY A(0)=[0 8 1 8 0 7 1 7 0 6
1 6 2 6 1 5 2 5 1 4 2 4 1 3 2 3 3
3 2 2 3 2 2 1 3 1 3 0 4 0 4 1 5 0
5 1 6 1 5 2 6 2 5 3 6 3 7 3 6 4 7
4 6 5 7 5 6 6 7 6 8 6 7 7 8 7 7 8
8 8 3 5 4 5 5 5 $FF]
BYTE ARRAY C(0)=[7 2 6 2 6 1 5 1 5 0
4 0 3 0 2 0 2 1 1 1 1 2 0 2 1 3 0
3 1 4 0 4 0 5 1 5 0 6 1 6 1 7 2 7
2 8 3 8 4 8 5 8 5 7 6 7 6 6 7 6
; hier fehlt das Ende
$FF]
BYTE ARRAY S(0)=[6 2 5 2 5 1 4 1 4 0
3 0 2 0 2 1 1 1 0 2 1 2 1 3 2 3 2
4 3 4 4 4 4 5 5 5 6 6 5 6 5 7 4 7
4 8 3 8 2 8 2 7 1 7 1 6 0 6 $FF]
BYTE ARRAY rev(0)=[0 0 0 1 0 2 0 3 0
4 0 5 0 6 1 6 1 5 1 4 1 3 1 2 1 1
1 0 2 0 3 0 4 1 4 2 3 3 2 3 3 4 4
5 4 6 7 0 8 0 7 1 8 1 7 2 8 2 7 3
8 3 7 4 8 4 7 5 8 5 7 6 8 6 11 0
10 0 9 0 10 3 9 3 11 6 10 6 9 6 14
0 15 0 14 1 15 1 14 2 15 2 15 3 16
3 15 4 16 4 16 5 16 6 17 6 17 5 18
4 18 3 19 2 19 1 19 0 22 5 21 5 21
6 22 6 27 6 28 6 27 5 28 5 27 4 28
4 28 3 29 3 28 2 29 2 29 1 29 0 30
0 30 1 31 2 31 3 32 4 32 5 32 6 29
5 30 5 31 5 $FF]
Init7()
color = 2
NMIEN = $40
old = VDSLST
VDSLST = Background
dlist = SDLST
dlist(6) ==% $80
dlist(97) ==% $80
NMIEN = $C0
Draw()
; j = 0
; WHILE j<10000 DO j==+1 OD
color = 3
Letter(side, 120, 10, 50)
Letter(rev, 105, 75, 50)
Letter(copyright, 96, 41, 100)
Letter(A, 109, 41, 100)
Letter(C, 121, 41, 100)
Letter(S, 132, 41, 100)
j = 0
WHILE j<2000 AND CH=$FF DO
i = 0
WHILE i<100 DO i==+1 OD
j = j + 1
OD
NMIEN = $40
VDSLST = NMI
start = 0
dlist(0) ==% $80
dlist(2) ==% $80
i = 3
WHILE i<101 DO
x = dlist(i)
dlist(i) = x % $80
IF x#$D THEN
i = i + 3
ELSE
i = i + 1
FI
OD
NMIEN = $C0
; Draw()
CH = $FF
WHILE CH#$1C DO
; SetColor(4, 0, 4)
; COLBK = 4
OD
NMIEN = $40
VDSLST = old
GetD(7)
Graphics(0)
RETURN
