aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

i all the A langs

Browse source
This commit is contained in:
Ingy döt Net 2013-04-10 14:16:51 -07:00
parent 86c034bb8b
commit 9246b988c7
245 changed files with 3941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

157
Task/99-Bottles-of-Beer/6502-Assembly/99-bottles-of-beer.6502 Normal file
View file

@ -0,0 +1,157 @@
.CR 6502
.TF AP1BEER.O,AP1
.LF AP1BEER.LST
.OR $0BEE
;-------------------------------------;
; BEER SONG IN 6502 ASSEMBLY LANGUAGE ;
; BY BARRYM 2010-05-30 ;
; THANKS TO SBPROJECTS.COM FOR LOTS ;
; OF VALUABLE INFORMATION AND A ;
; VERY NICE ASSEMBLER! ;
;-------------------------------------;
; THE TARGET MACHINE FOR THIS PROGRAM ;
; IS THE APPLE 1, BUT IT WOULD BE ;
; EASY TO MAKE IT RUN ON OTHER 65XX ;
; MACHINES BY CHANGING THE NEXT TWO ;
; EQUATES. SOME MACHINE-TESTED ;
; EXAMPLES: ;
; APPLE II, +, E, C: $FDED, $80 ;
; COMMODORE 64: $FFD2, $00 ;
;-------------------------------------;
ECHO = $FFEF EMIT A REG AS ASCII
ORMASK = $80 ($00 FOR + ASCII)
;
MAXBEER = 99 INITIAL BEER COUNT
;-------------------------------------;
; X REG. IS THE BOTTLE COUNTER. ;
; Y REG. IS THE STRING INDEX POINTER, ;
; AND THE TENS DIGIT IN THE BINARY- ;
; TO-ASCII CONVERSION ROUTINE. ;
; A REG. HANDLES EVERYTHING ELSE WITH ;
; A LITTLE HELP FROM THE STACK. ;
; ZERO PAGE ISN'T DIRECTLY DISTURBED. ;
;-------------------------------------;
; EMIT COMPLETE CORRECT SONG ADJUSTED ;
; FOR UPPER-CASE 40-COLUMN DISPLAY. ;
;-------------------------------------;
LDX #MAXBEER X=MAXBEER
BNE PRSONG SING THE SONG & RTS
;-------------------------------------;
; EMIT WHOLE SONG UP TO LAST SENTENCE.;
;-------------------------------------;
BEERME:
LDY #TAKE1-TXT ? "TAKE ... AROUND,"
JSR PRBOB ? X;" BOT ... WALL."
PRSONG: ; ?
LDY #CR-TXT ? X;" BOT ... WALL,"
JSR PRBOB ? X;" BOT ... BEER."
DEX X=X-1
BPL BEERME IF X>=0 THEN BEERME
;-------------------------------------;
; EMIT LAST SENTENCE AND FALL THROUGH.;
;-------------------------------------;
LDX #MAXBEER X=MAXBEER:
; ? "GO TO ... MORE,"
;-------------------------------------;
; PRINT A PROPERLY PUNCTUATED "BOTTLE ;
; OF BEER" SENTENCE. ;
;-------------------------------------;
PRBOB:
TYA
PHA SAVE THE PRE$ PTR
JSR PUTS ? PRE$;
TXA IF X=0 THEN
BEQ PRBOTT ? "NO MORE";
LDY #"0"-1 ELSE
SEC (
DIV10:
SBC #10 Y=INT(X/10)
INY
BCS DIV10
ADC #10+'0'
CPY #"0"
BEQ ONEDIG
PHA IF Y>0 THEN
TYA ? Y;
JSR PUTCH
PLA ? X MOD 10;
ONEDIG:
LDY #BOTTL-TXT )
PRBOTT:
JSR PUTCH ? " BOTTLE";
CPX #1
BNE PLURAL
INY IF X<>1 THEN ? "S";
PLURAL:
JSR PUTS ? " OF BEER";
PLA RECALL THE PRE$ PTR
CMP #COMCR-TXT
BEQ PRDOT
PHA IF APPROPRIATE THEN
JSR PUTS ? " ON THE WALL";
PLA
LDY #COMCR-TXT IF APPROPRIATE THEN
CMP #CR-TXT ? ",":
BEQ PRBOB ? X;" ... BEER";
PRDOT:
LDY #DOTCR-TXT ? "."
;-------------------------------------;
; EMIT A HI-BIT-SET TERMINATED STRING ;
; @ OFFSET Y AND EXIT WITH Y @ THE ;
; BEGINNING OF THE NEXT STRING. ;
;-------------------------------------;
PUTS:
LDA TXT,Y GRAB A STRING CHAR
INY ADVANCE STRING PTR
PUTCH:
PHA
ORA #ORMASK
AND #ORMASK+127 FORMAT CHAR FOR ECHO
JSR ECHO SHOOT IT TO CONSOLE
PLA
BPL PUTS LOOP IF APPROPRIATE
RTS
;-------------------------------------;
; OPTIMIZED SONG LYRIC STRINGS. ;
;-------------------------------------;
TXT:
TAKE1:
.AS "TAKE ONE DOWN AND"
.AS " PASS IT AROUND"
COMCR:
.AS ","
CR:
.AT #13
.AS "NO MORE"
BOTTL:
.AT " BOTTLE"
.AT "S OF BEER"
.AT " ON THE WALL"
DOTCR:
.AT ".",#13
.AS "GO TO THE STORE AND"
.AT " BUY SOME MORE,",#13
.EN
;-------------------------------------;
; APPLE 1 MONITOR HEX DUMP FOLLOWS. ;
; ENTER AS SHOWN INTO THE MONITOR, ;
; AND LET THE BEER FLOW!! ;
;-------------------------------------;
0BEE
:A2 63 D0 05 A0 00 20 01 0C A0 21 20 01
:0C CA 10 F3 A2 63 98 48 20 3C 0C 8A F0
:16 A0 AF 38 E9 0A C8 B0 FB 69 3A C0 B0
:F0 06 48 98 20 40 0C 68 A0 29 20 40 0C
:E0 01 D0 01 C8 20 3C 0C 68 C9 20 F0 0B
:48 20 3C 0C 68 A0 20 C9 21 F0 C7 A0 45
:B9 4C 0C C8 48 09 80 29 FF 20 EF FF 68
:10 F1 60 54 41 4B 45 20 4F 4E 45 20 44
:4F 57 4E 20 41 4E 44 20 50 41 53 53 20
:49 54 20 41 52 4F 55 4E 44 2C 8D 4E 4F
:20 4D 4F 52 45 20 42 4F 54 54 4C C5 53
:20 4F 46 20 42 45 45 D2 20 4F 4E 20 54
:48 45 20 57 41 4C CC 2E 8D 47 4F 20 54
:4F 20 54 48 45 20 53 54 4F 52 45 20 41
:4E 44 20 42 55 59 20 53 4F 4D 45 20 4D
:4F 52 45 2C 8D
BEER

157
Task/99-Bottles-of-Beer/6800-Assembly/99-bottles-of-beer.6800 Normal file
View file

@ -0,0 +1,157 @@
.cr 6800
.tf beer6800.obj,AP1
.lf beer6800
;=====================================================;
; Beer Song for the Motorola 6800 microprocessor ;
; by barrym 2011-04-19 ;
;-----------------------------------------------------;
; Prints the correct, complete song lyrics to a full ;
; ascii terminal (console) connected to a 1970s ;
; vintage SWTPC 6800 system, which is the target ;
; device for this assembly. ;
; Many thanks to: ;
; swtpc.com for hosting Michael Holley's documents! ;
; sbprojects.com for a very nice assembler! ;
; swtpcemu.com for a very capable emulator! ;
; The 6800 microprocessor is the slightly older, less ;
; popular, and more expensive step-brother of the ;
; 6502. Numerous similarities exist between the ;
; assembly languages of the two, but the 6800 has ;
; its own distinct flavor, which is (judging by how ;
; compact the code ended up) well suited to this ;
; type of small program. I am especially impressed ;
; with the two-byte 'bsr' instruction, and I make ;
; extensive use of it here. ;
; Effort was made to keep the code footprint as small ;
; as possible by re-using substrings and code in a ;
; hacker-like style that makes the program flow a ;
; bit strange to the human eye (the 6800 gobbles it ;
; up without complaint). The final tally: 97 bytes ;
; of instructions, 108 bytes of text, and about 11 ;
; bytes of stack. This includes integer-to-ascii ;
; conversion, blank line between verses, removal of ;
; "s" from "1 bottles", substitution of "no more" ;
; for "0", and proper capitalization of "No more". ;
; reg b is the beer counter ;
; reg x is the string pointer ;
; reg a handles everything else (with a little help ;
; from the system stack) ;
;-----------------------------------------------------;
outeee = $e1d1 ROM: console putchar routine
stbeer = 99 Must be in the range [0..99]
.or $0f00
;=====================================================;
; Initialize, sing the song, and exit ;
;-----------------------------------------------------;
main ldab #stbeer Beer count = stbeer
bsr prsong Sing the entire song
swi Return to the monitor.
;=====================================================;
; Emit the entire song up to the last sentence ;
;-----------------------------------------------------;
beerme bsr prbob2 Emit second sentence of verse
prsong ldx #nline Blank line between verses
ldaa #'N' First sentence type = 'N'
bsr prbob Emit 1st sentence of verse
decb Beer count -= 1
bpl beerme If beer count >= 0 then beerme
;=====================================================;
; Set up the last sentence and fall through to prbob2 ;
;-----------------------------------------------------;
ldab #stbeer Beer count = stbeer
ldx #store x$ = "Go to the store ..."
;=====================================================;
; Emit a properly punctuated bottle-of-beer sentence, ;
; using beer counter in reg b, pre-string pointer ;
; in reg x, and the sentence type in reg a ('N' = ;
; sentence 1, 'o' = sentence 1.5, 'n' = sentence 2) ;
;-----------------------------------------------------;
prbob2 ldaa #'n' Second sentence type = 'n'
prbob psha Stack sentence type for later
bsr puts Emit pre-string
pula Check sentence type and use
psha it to prepare the upper- or
anda #'n' lower-case of "no more"
ldx #omore x$ = "o more bottle"
tstb If beer count = 0 then
beq prbott skip over the i-to-a
ldx #bottl x$ = " bottle"
;=====================================================;
; I-to-A (inline): convert int in b to ascii and emit ;
; with leading zero suppression (0 <= # <= 99)! ;
;-----------------------------------------------------;
pshb Stack beer count
ldaa #-1 (divten trashes it)
divten subb #10 b = ones digit - 10
inca a = tens digit
bcc divten If a = 0 then
beq onedig suppress leading zero
adda #"0" else translate tens digit to
bsr putch shifted ascii and emit
onedig addb #'0'+10 Translate ones digit to ascii
tba and leave it in a for putch
pulb Restore beer count
;-----------------------------------------------------;
prbott bsr putch Emit a;x$;
cmpb #1 If beer count = 1
bne plural then
inx skip over the "s"
plural bsr puts Emit " ... beer";
pula Restore sentence type
cmpa #'o' If type <> 'o'
beq putdot then
psha emit " on the wall";
bsr puts if type = 'N' then loop
pula back to finish the
adda #33 first sentence with
bpl prbob type = 'o', x$ = ", "
putdot ldx #dotnl x$ = ".\n"
;=====================================================;
; Emit string @ x and leave x @ start of next string ;
;-----------------------------------------------------;
puts ldaa 0,x a = raw character removed
inx from the beginning of x$
;=====================================================;
; Emit a as ascii and loop into x$ if hi-bit is clear ;
;-----------------------------------------------------;
putch psha Stack raw char
anda #$7f Mask off the hi-bit
jsr outeee Emit a as 7-bit ascii
pula Restore raw char
tsta If hi-bit is clear then
bpl puts loop back into x$
rts All 8 'bsr's use this 'rts'!
;=====================================================;
; Optimized song lyric strings, carefully arranged to ;
; allow the prbob subroutine to take full advantage ;
; of the x register side-effects of puts ;
;-----------------------------------------------------;
omore .as "o more"
bottl .at " bottle"
.at "s of beer"
.at " on the wall"
.at ", "
dotnl .as "."
nline .at #13,#10
.at "Take one down and pass it around, "
store .at "Go to the store and buy some more, "
.en
;=====================================================;
; The following is a hex dump of the object file, ;
; suitable for copying and pasting into the 6800 ;
; emulator available at swtpcemu.com! ;
;-----------------------------------------------------;
e0F00 C6 63 8D 03 3F 8D 0F CE 0F 86 86 4E 8D 0A 5A 2A
e0F10 F4 C6 63 CE 0F AA 86 6E 36 8D 38 32 36 84 6E CE
e0F20 0F 61 5D 27 15 CE 0F 67 37 86 FF C0 0A 4C 24 FB
e0F30 27 04 8B B0 8D 20 17 8B 3A 33 8D 1A C1 01 26 01
e0F40 08 8D 10 32 81 6F 27 08 36 8D 08 32 8B 21 2A C8
e0F50 CE 0F 85 A6 00 08 36 84 7F BD E1 D1 32 4D 2A F3
e0F60 39 6F 20 6D 6F 72 65 20 62 6F 74 74 6C E5 73 20
e0F70 6F 66 20 62 65 65 F2 20 6F 6E 20 74 68 65 20 77
e0F80 61 6C EC 2C A0 2E 0D 8A 54 61 6B 65 20 6F 6E 65
e0F90 20 64 6F 77 6E 20 61 6E 64 20 70 61 73 73 20 69
e0FA0 74 20 61 72 6F 75 6E 64 2C A0 47 6F 20 74 6F 20
e0FB0 74 68 65 20 73 74 6F 72 65 20 61 6E 64 20 62 75
e0FC0 79 20 73 6F 6D 65 20 6D 6F 72 65 2C A0
j0F00

8
Task/99-Bottles-of-Beer/ALGOL-68/99-bottles-of-beer.alg Normal file
View file

@ -0,0 +1,8 @@
main:(
FOR bottles FROM 99 TO 1 BY -1 DO
printf(($z-d" bottles of beer on the wall"l$, bottles));
printf(($z-d" bottles of beer"l$, bottles));
printf(($"Take one down, pass it around"l$));
printf(($z-d" bottles of beer on the wall"ll$, bottles-1))
OD
)

13
Task/99-Bottles-of-Beer/ATS/99-bottles-of-beer.ats Normal file
View file

@ -0,0 +1,13 @@
/* .<n>. is a termination metric to prove that the function terminates. It can be omitted. */
fun bottles {n:nat} .<n>. (n: int n): void =
if n = 0 then
()
else begin
printf ("%d bottles of beer on the wall\n", @(n));
printf ("%d bottles of beer\n", @(n));
printf ("Take one down, pass it around\n", @());
printf ("%d bottles of beer on the wall\n", @(n-1));
bottles (n - 1)
end
implement main () = bottles (99)

20
Task/99-Bottles-of-Beer/Aime/99-bottles-of-beer.aime Normal file
View file

@ -0,0 +1,20 @@
integer
main(void)
{
cardinal bottles;
bottles = 99;
do {
o_cardinal(bottles);
o_text(" bottles of beer on the wall\n");
o_cardinal(bottles);
o_text(" bottles of beer\n");
o_text("Take one down, pass it around\n");
bottles -= 1;
o_cardinal(bottles);
o_text(" bottles of beer on the wall\n\n");
} while (bottles);
return 0;
}

13
Task/99-Bottles-of-Beer/AmigaE/99-bottles-of-beer.amiga Normal file
View file

@ -0,0 +1,13 @@
PROC main()
DEF t: PTR TO CHAR,
s: PTR TO CHAR,
u: PTR TO CHAR, i, x
t := 'Take one down, pass it around\n'
s := '\d bottle\s of beer\s\n'
u := ' on the wall'
FOR i := 99 TO 0 STEP -1
ForAll({x}, [u, NIL], `WriteF(s, i, IF i <> 1 THEN 's' ELSE NIL,
x))
IF i > 0 THEN WriteF(t)
ENDFOR
ENDPROC

7
Task/99-Bottles-of-Beer/Applesoft-BASIC/99-bottles-of-beer.bas Normal file
View file

@ -0,0 +1,7 @@
10 HOME
20 FOR B=99 TO 1 STEP -1
30 PRINT B;" BOTTLE OF BEER ON THE WALL"
40 PRINT B;" BOTTLE OF BEER ON THE WALL"
50 PRINT "TAKE ONE DOWN, PASS IT AROUND"
60 PRINT B-1;" BOTTLE OF BEER ON THE WALL"
70 NEXT B

22
Task/99-Bottles-of-Beer/Arbre/99-bottles-of-beer.arbre Normal file
View file

@ -0,0 +1,22 @@
bottle(x):
template: '
$x bottles of beer on the wall.
$x bottles of beer.
Take one down and pass it around,
$y bottles of beer on the wall.
'
if x==0
template~{x: 'No more', y: 'No more'}
else
if x==1
template~{x: x, y: 'No more'}
else
template~{x: x, y: x-1}
bottles(n):
for x in [n..0]
bottle(x)
99bottles():
bottles(99) -> io

19
Task/99-Bottles-of-Beer/Argile/99-bottles-of-beer.argile Normal file
View file

@ -0,0 +1,19 @@
use std
let X be an int
for each X from 99 down to 1
prints X bottles of beer on the wall
prints X bottles of beer
prints "Take one down, pass it" around
if X == 1
echo No more "beer." Call da "amber lamps"
break
X--
prints X bottles of beer on the wall "\n"
X++
.:around :. -> text {X>59 ? "around", "to me"}
.:bottles:. -> text {X> 5 ? "bottles", (X>1 ? "buttles", "wall")}
.:of beer:. -> text {X>11 ? "of beer", "ov beeer"}
.:on the wall:. -> text {
X>17 ? "on the wall", (X>1 ? "on the bwall", "in the buttle")
}

15
Task/99-Bottles-of-Beer/AutoHotkey/99-bottles-of-beer-1.ahk Normal file
View file

@ -0,0 +1,15 @@
; RC: 99 bottles of beer
b = 99
Loop, %b% {
s .= b . " bottles of beer on the wall,`n"
. b . " bottles of beer.`nTake one down, pass it around,`n"
. b-1 . " bottles of beer on the wall.`n`n"
b--
}
Gui, Add, Edit, w200 h200, %s%
Gui, Show, , 99 bottles of beer
Return ; end of auto-execute section
GuiClose:
ExitApp
Return

17
Task/99-Bottles-of-Beer/AutoHotkey/99-bottles-of-beer-2.ahk Normal file
View file

@ -0,0 +1,17 @@
n=99
Gui, Font, s20 cMaroon, Comic Sans MS
Gui, Add, Text, w500 vLyrics, %n% bottles of beer on the wall...
Gui, Show
Loop {
Sleep, 2000
GuiControl,,Lyrics,% n!=1 ? n " bottles of beer.":n " bottle of beer."
Sleep, 2000
GuiControl,,Lyrics,% n ? "Take one down, pass it around...":"Go to the store, buy some more..."
Sleep, 2000
n := n ? --n:99
GuiControl,,Lyrics,% n!=1 ? n " bottles of beer on the wall.":n " bottle of beer on the wall."
Sleep, 2000
GuiControl,,Lyrics,% n!=1 ? n " bottles of beer on the wall...":n " bottle of beer on the wall..."
}
GuiClose:
ExitApp

7
Task/99-Bottles-of-Beer/AutoHotkey/99-bottles-of-beer-3.ahk Normal file
View file

@ -0,0 +1,7 @@
b=99
Loop, %b% {
s := b " bottles of beer on the wall, " b " bottles of beer, Take one down, pass it around " b-1 " bottles of beer on the wall"
b--
TrayTip,,%s%
sleep, 40
}

10
Task/99-Bottles-of-Beer/AutoHotkey/99-bottles-of-beer-4.ahk Normal file
View file

@ -0,0 +1,10 @@
N=o more
Z=99
L:=Z M:=(B:=" bottle")"s"
Loop 99
V.=L (W:=(O:=" of beer")" on the wall")",`n"L O ",`nTake one down and pass it around,`n"(L:=(--Z ? Z:"N"N)(Z=1 ? B:M))W ".`n`n"
Gui,Add,Edit,w600 h250,% V L W ", n"N M O ".`nGo to the store and buy some more, 99"M W "."
Gui,Show
Return
GuiClose:
ExitApp

21
Task/99-Bottles-of-Beer/AutoIt/99-bottles-of-beer.autoit Normal file
View file

@ -0,0 +1,21 @@
local $bottleNo=99
local $lyrics=" "
While $bottleNo<>0
If $bottleNo=1 Then
$lyrics&=$bottleNo & " bottles of beer on the wall" & @CRLF
$lyrics&=$bottleNo & " bottles of beer" & @CRLF
$lyrics&="Take one down, pass it around" & @CRLF
Else
$lyrics&=$bottleNo & " bottles of beer on the wall" & @CRLF
$lyrics&=$bottleNo & " bottles of beer" & @CRLF
$lyrics&="Take one down, pass it around" & @CRLF
EndIf
If $bottleNo=1 Then
$lyrics&=$bottleNo-1 & " bottle of beer" & @CRLF
Else
$lyrics&=$bottleNo-1 & " bottles of beer" & @CRLF
EndIf
$bottleNo-=1
WEnd
MsgBox(1,"99",$lyrics)

21
Task/Ackermann-function/ALGOL-68/ackermann-function.alg Normal file
View file

@ -0,0 +1,21 @@
PROC test ackermann = VOID:
BEGIN
PROC ackermann = (INT m, n)INT:
BEGIN
IF m = 0 THEN
n + 1
ELIF n = 0 THEN
ackermann (m - 1, 1)
ELSE
ackermann (m - 1, ackermann (m, n - 1))
FI
END # ackermann #;
FOR m FROM 0 TO 3 DO
FOR n FROM 0 TO 6 DO
print(ackermann (m, n))
OD;
new line(stand out)
OD
END # test ackermann #;
test ackermann

5
Task/Ackermann-function/APL/ackermann-function.apl Normal file
View file

@ -0,0 +1,5 @@
ackermann←{
0=1⊃⍵:1+2⊃⍵
0=2⊃⍵:∇(¯1+1⊃⍵)1
∇(¯1+1⊃⍵),∇(1⊃⍵),¯1+2⊃⍵
}

8
Task/Ackermann-function/ATS/ackermann-function.ats Normal file
View file

@ -0,0 +1,8 @@
fun ackermann
{m,n:nat} .<m,n>.
(m: int m, n: int n): Nat =
case+ (m, n) of
| (0, _) => n+1
| (_, 0) =>> ackermann (m-1, 1)
| (_, _) =>> ackermann (m-1, ackermann (m, n-1))
// end of [ackermann]

10
Task/Ackermann-function/Argile/ackermann-function.argile Normal file
View file

@ -0,0 +1,10 @@
use std
for each (val nat n) from 0 to 6
for each (val nat m) from 0 to 3
print "A("m","n") = "(A m n)
.:A <nat m, nat n>:. -> nat
return (n+1) if m == 0
return (A (m - 1) 1) if n == 0
A (m - 1) (A m (n - 1))

11
Task/Ackermann-function/AutoHotkey/ackermann-function.ahk Normal file
View file

@ -0,0 +1,11 @@
A(m, n) {
If (m > 0) && (n = 0)
Return A(m-1,1)
Else If (m > 0) && (n > 0)
Return A(m-1,A(m, n-1))
Else If (m=0)
Return n+1
}
; Example:
MsgBox, % "A(1,2) = " A(1,2)

17
Task/Anagrams/AutoHotkey/anagrams.ahk Normal file
View file

@ -0,0 +1,17 @@
MsgBox % anagrams("able")
anagrams(word) {
Static dict
IfEqual dict,, FileRead dict, unixdict.txt ; file in the script directory
w := sort(word)
Loop Parse, dict, `n, `r
If (w = sort(A_LoopField))
t .= A_LoopField "`n"
Return t
}
sort(word) {
a := RegExReplace(word,".","$0`n")
Sort a
Return a
}

20
Task/Arrays/ALGOL-68/arrays-1.alg Normal file
View file

@ -0,0 +1,20 @@
PROC array_test = VOID:
(
[1:20]INT a;
a := others; # assign whole array #
a[1] := -1; # assign individual element #
a[3:5] := (2, 4, -1); # assign a slice #
[1:3]INT slice = a[3:5]; # copy a slice #
REF []INT rslice = a[3:5]; # create a reference to a slice #
print((LWB rslice, UPB slice)); # query the bounds of the slice #
rslice := (2, 4, -1); # assign to the slice, modifying original array #
[1:3, 1:3]INT matrix; # create a two dimensional array #
REF []INT hvector = matrix[2,]; # create a reference to a row #
REF []INT vvector = matrix[,2]; # create a reference to a column #
REF [,]INT block = matrix[1:2, 1:2]; # create a reference to an area of the array #
FLEX []CHAR string := "Hello, world!"; # create an array with variable bounds #
string := "shorter" # flexible arrays automatically resize themselves on assignment #
)

17
Task/Arrays/ALGOL-68/arrays-2.alg Normal file
View file

@ -0,0 +1,17 @@
DEF ai[100] : ARRAY OF CHAR, -> static
da: PTR TO CHAR,
la: PTR TO CHAR
PROC main()
da := New(100)
-> or
NEW la[100]
IF da <> NIL
ai[0] := da[0] -> first is 0
ai[99] := da[99] -> last is "size"-1
Dispose(da)
ENDIF
-> using NEW, we must specify the size even when
-> "deallocating" the array
IF la <> NIL THEN END la[100]
ENDPROC

2
Task/Arrays/ALGOL-68/arrays-3.alg Normal file
View file

@ -0,0 +1,2 @@
set empty to {}
set ints to {1, 2, 3}

1
Task/Arrays/ALGOL-68/arrays-4.alg Normal file
View file

@ -0,0 +1 @@
set any to {1, "foo", 2.57, missing value, ints}

15
Task/Arrays/Aikido/arrays.aikido Normal file
View file

@ -0,0 +1,15 @@
var arr1 = [1,2,3,4] // initialize with array literal
var arr2 = new [10] // empty array of 10 elements (each element has value none)
var arr3 = new int [40] // array of 40 integers
var arr4 = new Object (1,2) [10] // array of 10 instances of Object
arr1.append (5) // add to array
var b = 4 in arr1 // check for inclusion
arr1 <<= 2 // remove first 2 elements from array
var arrx = arr1[1:3] // get slice of array
var s = arr1.size() // or sizeof(arr1)
delete arr4[2] // remove an element from an array
var arr5 = arr1 + arr2 // append arrays
var arr6 = arr1 | arr2 // union
var arr7 = arr1 & arr2 // intersection

31
Task/Arrays/Argile/arrays-1.argile Normal file
View file

@ -0,0 +1,31 @@
use std, array
(:::::::::::::::::
: Static arrays :
:::::::::::::::::)
let the array of 2 text aabbArray be Cdata{"aa";"bb"}
let raw array of real :my array: = Cdata {1.0 ; 2.0 ; 3.0} (: auto sized :)
let another_array be an array of 256 byte (: not initialised :)
let (raw array of (array of 3 real)) foobar = Cdata {
{1.0; 2.0; 0.0}
{5.0; 1.0; 3.0}
}
(: macro to get size of static arrays :)
=: <array>.length := -> nat {size of array / (size of array[0])}
printf "%lu, %lu\n" foobar.length (another_array.length) (: 2, 256 :)
(: access :)
another_array[255] = '&'
printf "`%c'\n" another_array[255]
(::::::::::::::::::
: Dynamic arrays :
::::::::::::::::::)
let DynArray = new array of 5 int
DynArray[0] = -42
DynArray = (realloc DynArray (6 * size of DynArray[0])) as (type of DynArray)
DynArray[5] = 243
prints DynArray[0] DynArray[5]
del DynArray

4
Task/Arrays/Argile/arrays-2.argile Normal file
View file

@ -0,0 +1,4 @@
use std, array
let x = @["foo" "bar" "123"]
print x[2]
x[2] = "abc"

7
Task/Arrays/AutoHotkey/arrays-1.ahk Normal file
View file

@ -0,0 +1,7 @@
myArray := Object() ; could use JSON-syntax sugar like {key: value}
myArray[1] := "foo"
myArray[2] := "bar"
MsgBox % myArray[2]
; Push a value onto the array
myArray.Insert("baz")

11
Task/Arrays/AutoHotkey/arrays-2.ahk Normal file
View file

@ -0,0 +1,11 @@
arrayX0 = 4 ; length
arrayX1 = first
arrayX2 = second
arrayX3 = foo
arrayX4 = bar
Loop, %arrayX0%
Msgbox % arrayX%A_Index%
source = apple bear cat dog egg fish
StringSplit arrayX, source, %A_Space%
Loop, %arrayX0%
Msgbox % arrayX%A_Index%

14
Task/Arrays/AutoIt/arrays.autoit Normal file
View file

@ -0,0 +1,14 @@
#include <Array.au3> ;Include extended Array functions (_ArrayDisplay)
Local $aInputs[1] ;Create the Array with just 1 element
While True ;Endless loop
$aInputs[UBound($aInputs) - 1] = InputBox("Array", "Add one value") ;Save user input to the last element of the Array
If $aInputs[UBound($aInputs) - 1] = "" Then ;If an empty string is entered, then...
ReDim $aInputs[UBound($aInputs) - 1] ;...remove them from the Array and...
ExitLoop ;... exit the loop!
EndIf
ReDim $aInputs[UBound($aInputs) + 1] ;Add an empty element to the Array
WEnd
_ArrayDisplay($aInputs) ;Display the Array

5
Task/Assertions/ALGOL-68/assertions-1.alg Normal file
View file

@ -0,0 +1,5 @@
OP ASSERT = (VECTOR [] CHAR assertion,BOOL valid) VOID:
IF NOT valid
THEN type line on terminal(assertion);
terminal error( 661 {invalid assertion } )
FI;

7
Task/Assertions/ALGOL-68/assertions-2.alg Normal file
View file

@ -0,0 +1,7 @@
PROGRAM assertions CONTEXT VOID
USE standard,environment
BEGIN
INT a := 43;
"Oops!" ASSERT ( a = 42 )
END
FINISH

8
Task/Assertions/AutoHotkey/assertions-1.ahk Normal file
View file

@ -0,0 +1,8 @@
a := 42
Assert(a > 10)
Assert(a < 42) ; throws exception
Assert(bool){
If !bool
throw Exception("Expression false", -1)
}

6
Task/Assertions/AutoHotkey/assertions-2.ahk Normal file
View file

@ -0,0 +1,6 @@
if (a != 42)
{
OutputDebug, "a != 42" ; sends output to a debugger if connected
ListVars ; lists values of local and global variables
Pause ; pauses the script, use ExitApp to exit instead
}

19
Task/Balanced-brackets/ANTLR/balanced-brackets.antlr Normal file
View file

@ -0,0 +1,19 @@
grammar balancedBrackets ;
options {
language = Java;
}
bb : {System.out.print("input is: ");} (balancedBrackets {System.out.print($balancedBrackets.text);})* NEWLINE {System.out.println();}
;
balancedBrackets
: OpenBracket balancedBrackets* CloseBracket
;
OpenBracket
: '['
;
CloseBracket
: ']'
;
NEWLINE : '\r'? '\n'
;

32
Task/Balanced-brackets/AutoHotkey/balanced-brackets-1.ahk Normal file
View file

@ -0,0 +1,32 @@
; Generate 10 strings with equal left and right brackets
Loop, 5
{
B = %A_Index%
loop 2
{
String =
Loop % B
String .= "[`n"
Loop % B
String .= "]`n"
Sort, String, Random
StringReplace, String, String,`n,,All
Example .= String " - " IsBalanced(String) "`n"
}
}
MsgBox % Example
return
IsBalanced(Str)
{
Loop, PARSE, Str
{
If A_LoopField = [
i++
Else if A_LoopField = ]
i--
If i < 0
return "NOT OK"
}
Return "OK"
}

23
Task/Balanced-brackets/AutoHotkey/balanced-brackets-2.ahk Normal file
View file

@ -0,0 +1,23 @@
Loop, 5
{
B = %A_Index%
loop 2
{
String =
Loop % B
String .= "[`n"
Loop % B
String .= "]`n"
Sort, String, Random
StringReplace, String, String,`n,,All
Example .= String " - " IsBalanced(String) "`n"
}
}
MsgBox % Example
return
IsBalanced(Str){
While (Instr(Str,"[]"))
StringReplace, Str, Str,[],,All
Return Str ? "False" : "True"
}

28
Task/Balanced-brackets/AutoIt/balanced-brackets.autoit Normal file
View file

@ -0,0 +1,28 @@
#include <Array.au3>
Local $Array[1]
_ArrayAdd($Array, "[]")
_ArrayAdd($Array, "[][]")
_ArrayAdd($Array, "[[][]]")
_ArrayAdd($Array, "][")
_ArrayAdd($Array, "][][")
_ArrayAdd($Array, "[]][[]")
For $i = 0 To UBound($Array) -1
Balanced_Brackets($Array[$i])
If @error Then
ConsoleWrite($Array[$i] &" = NOT OK"&@CRLF)
Else
ConsoleWrite($Array[$i] &" = OK"&@CRLF)
EndIf
Next
Func Balanced_Brackets($String)
Local $cnt = 0
$Split = Stringsplit($String, "")
For $i = 1 To $Split[0]
If $split[$i] = "[" Then $cnt += 1
If $split[$i] = "]" Then $cnt -= 1
If $cnt < 0 Then Return SetError(1,0,0)
Next
Return 1
EndFunc

52
Task/Best-shuffle/AutoHotkey/best-shuffle.ahk Normal file
View file

@ -0,0 +1,52 @@
words := "abracadabra,seesaw,elk,grrrrrr,up,a"
Loop Parse, Words,`,
out .= Score(A_LoopField, Shuffle(A_LoopField))
MsgBox % clipboard := out
Shuffle(String)
{
Cord := String
Length := StrLen(String)
CharType := A_IsUnicode ? "UShort" : "UChar"
Loop, Parse, String ; For each old character in String...
{
Char1 := SubStr(Cord, A_Index, 1)
If (Char1 <> A_LoopField) ; If new character already differs,
Continue ; do nothing.
Index1 := A_Index
OldChar1 := A_LoopField
Random, Index2, 1, Length ; Starting at some random index,
Loop, %Length% ; for each index...
{
If (Index1 <> Index2) ; Swap requires two different indexes.
{
Char2 := SubStr(Cord, Index2, 1)
OldChar2 := SubStr(String, Index2, 1)
; If after the swap, the two new characters would differ from
; the two old characters, then do the swap.
If (Char1 <> OldChar2) and (Char2 <> OldChar1)
{
; Swap Char1 and Char2 inside Cord.
NumPut(Asc(Char1), Cord, (Index2 - 1) << !!A_IsUnicode, CharType)
NumPut(Asc(Char2), Cord, (Index1 - 1) << !!A_IsUnicode, CharType)
Break
}
}
Index2 += 1 ; Get next index.
If (Index2 > Length) ; If after last index,
Index2 := 1 ; use first index.
}
}
Return Cord
}
Score(a, b){
r := 0
Loop Parse, a
If (A_LoopField = SubStr(b, A_Index, 1))
r++
return a ", " b ", (" r ")`n"
}

47
Task/Binary-search/ALGOL-68/binary-search.alg Normal file
View file

@ -0,0 +1,47 @@
MODE ELEMENT = STRING;
# Iterative: #
PROC iterative binary search = ([]ELEMENT hay stack, ELEMENT needle)INT: (
INT out,
low := LWB hay stack,
high := UPB hay stack;
WHILE low < high DO
INT mid := (low+high) OVER 2;
IF hay stack[mid] > needle THEN high := mid-1
ELIF hay stack[mid] < needle THEN low := mid+1
ELSE out:= mid; stop iteration FI
OD;
low EXIT
stop iteration:
out
# Recursive: #
PROC recursive binary search = ([]ELEMENT hay stack, ELEMENT needle)INT: (
IF LWB hay stack > UPB hay stack THEN
LWB hay stack
ELIF LWB hay stack = UPB hay stack THEN
IF hay stack[LWB hay stack] = needle THEN LWB hay stack
ELSE LWB hay stack FI
ELSE
INT mid := (LWB hay stack+UPB hay stack) OVER 2;
IF hay stack[mid] > needle THEN recursive binary search(hay stack[:mid-1], needle)
ELIF hay stack[mid] < needle THEN mid + recursive binary search(hay stack[mid+1:], needle)
ELSE mid FI
FI
);
# Test cases: #
test:(
ELEMENT needle = "mister";
[]ELEMENT hay stack = ("AA","Maestro","Mario","Master","Mattress","Mister","Mistress","ZZ"),
test cases = ("A","Master","Monk","ZZZ");
PROC test search = (PROC([]ELEMENT, ELEMENT)INT search, []ELEMENT test cases)VOID:
FOR case TO UPB test cases DO
ELEMENT needle = test cases[case];
INT index = search(hay stack, needle);
BOOL found = ( index <= 0 | FALSE | hay stack[index]=needle);
printf(($""""g""" "b("FOUND at","near")" index "dl$, needle, found, index))
OD;
test search(iterative binary search, test cases);
test search(recursive binary search, test cases)
)

33
Task/Binary-search/AutoHotkey/binary-search.ahk Normal file
View file

@ -0,0 +1,33 @@
array := "1,2,4,6,8,9"
StringSplit, A, array, `, ; creates associative array
MsgBox % x := BinarySearch(A, 4, 1, A0) ; Recursive
MsgBox % A%x%
MsgBox % x := BinarySearchI(A, A0, 4) ; Iterative
MsgBox % A%x%
BinarySearch(A, value, low, high) { ; A0 contains length of array
If (high < low) ; A1, A2, A3...An are array elements
Return not_found
mid := Floor((low + high) / 2)
If (A%mid% > value) ; A%mid% is automatically global since no such locals are present
Return BinarySearch(A, value, low, mid - 1)
Else If (A%mid% < value)
Return BinarySearch(A, value, mid + 1, high)
Else
Return mid
}
BinarySearchI(A, lengthA, value) {
low := 0
high := lengthA - 1
While (low <= high) {
mid := Floor((low + high) / 2) ; round to lower integer
If (A%mid% > value)
high := mid - 1
Else If (A%mid% < value)
low := mid + 1
Else
Return mid
}
Return not_found
}

93
Task/Binary-strings/ALGOL-68/binary-strings.alg Normal file
View file

@ -0,0 +1,93 @@
# String creation #
STRING a,b,c,d,e,f,g,h,i,j,l,r;
a := "hello world";
print((a, new line));
# String destruction (for garbage collection) #
b := ();
BEGIN
LOC STRING lb := "hello earth"; # allocate off the LOC stack #
HEAP STRING hb := "hello moon"; # allocate out of the HEAP space #
~
END; # local variable "lb" has LOC stack space recovered at END #
# String assignment #
c := "a"+REPR 0+"b";
print (("string length c:", UPB c, new line));# ==> 3 #
# String comparison #
l := "ab"; r := "CD";
BOOL result;
FORMAT summary = $""""g""" is "b("","NOT ")"lexicographically "g" """g""""l$ ;
result := l < r OR l LT r; printf((summary, l, result, "less than", r));
result := l <= r OR l LE r # OR l ≤ r #; printf((summary, l, result, "less than or equal to", r));
result := l = r OR l EQ r; printf((summary, l, result, "equal to", r));
result := l /= r OR l NE r # OR l ≠ r #; printf((summary, l, result, "not equal to", r));
result := l >= r OR l GE r # OR l ≥ r #; printf((summary, l, result, "greater than or equal to", r));
result := l > r OR l GT r; printf((summary, l, result, "greater than", r));
# String cloning and copying #
e := f;
# Check if a string is empty #
IF g = "" THEN print(("g is empty", new line)) FI;
IF UPB g = 0 THEN print(("g is empty", new line)) FI;
# Append a byte to a string #
h +:= "A";
# Append a string to a string #
h +:= "BCD";
h PLUSAB "EFG";
# Prepend a string to a string - because STRING addition isn't communitive #
"789" +=: h;
"456" PLUSTO h;
print(("The result of prepends and appends: ", h, new line));
# Extract a substring from a string #
i := h[2:3];
print(("Substring 2:3 of ",h," is ",i, new line));
# Replace every occurrences of a byte (or a string) in a string with another string #
PROC replace = (STRING string, old, new, INT count)STRING: (
INT pos;
STRING tail := string, out;
TO count WHILE string in string(old, pos, tail) DO
out +:= tail[:pos-1]+new;
tail := tail[pos+UPB old:]
OD;
out+tail
);
j := replace("hello world", "world", "planet", max int);
print(("After replace string: ", j, new line));
INT offset = 7;
# Replace a character at an offset in the string #
j[offset] := "P";
print(("After replace 7th character: ", j, new line));
# Replace a substring at an offset in the string #
j[offset:offset+3] := "PlAN";
print(("After replace 7:10th characters: ", j, new line));
# Insert a string before an offset in the string #
j := j[:offset-1]+"INSERTED "+j[offset:];
print(("Insert string before 7th character: ", j, new line));
# Join strings #
a := "hel";
b := "lo w";
c := "orld";
d := a+b+c;
print(("a+b+c is ",d, new line));
# Pack a string into the target CPU's word #
BYTES word := bytes pack(d);
# Extract a CHAR from a CPU word #
print(("7th byte in CPU word is: ", offset ELEM word, new line))

55
Task/Bulls-and-cows/ALGOL-68/bulls-and-cows.alg Normal file
View file

@ -0,0 +1,55 @@
STRING digits = "123456789";
[4]CHAR chosen;
STRING available := digits;
FOR i TO UPB chosen DO
INT c = ENTIER(random*UPB available)+1;
chosen[i] := available[c];
available := available[:c-1]+available[c+1:]
OD;
COMMENT print((chosen, new line)); # Debug # END COMMENT
OP D = (INT d)STRING: whole(d,0); # for formatting an integer #
print (("I have chosen a number from ",D UPB chosen," unique digits from 1 to 9 arranged in a random order.", new line,
"You need to input a ",D UPB chosen," digit, unique digit number as a guess at what I have chosen", new line));
PRIO WITHIN = 5, NOTWITHIN = 5;
OP WITHIN = (CHAR c, []CHAR s)BOOL: char in string(c,LOC INT,s);
OP NOTWITHIN = (CHAR c, []CHAR s)BOOL: NOT ( c WITHIN s );
INT guesses := 0, bulls, cows;
WHILE
STRING guess;
guesses +:= 1;
WHILE
# get a good guess #
print((new line,"Next guess [",D guesses,"]: "));
read((guess, new line));
IF UPB guess NE UPB chosen THEN
FALSE
ELSE
BOOL ok;
FOR i TO UPB guess WHILE
ok := guess[i] WITHIN digits AND guess[i] NOTWITHIN guess[i+1:]
DO SKIP OD;
NOT ok
FI
DO
print(("Problem, try again. You need to enter ",D UPB chosen," unique digits from 1 to 9", new line))
OD;
# WHILE #
guess NE chosen
DO
bulls := cows := 0;
FOR i TO UPB chosen DO
IF guess[i] = chosen[i] THEN
bulls +:= 1
ELIF guess[i] WITHIN chosen THEN
cows +:= 1
FI
OD;
print((" ",D bulls," Bulls",new line," ",D cows," Cows"))
OD;
print((new line, "Congratulations you guessed correctly in ",D guesses," attempts.",new line))

28
Task/Bulls-and-cows/AutoHotkey/bulls-and-cows.ahk Normal file
View file

@ -0,0 +1,28 @@
While StrLen(Code) < 4 {
Random, num, 1, 9
If !InStr(Code, num)
Code .= num
}
Gui, Add, Edit, vGuess, Enter a guess...
Gui, Add, Button, wp Default, Submit
Gui, Add, ListBox, ym r8 vHistory
Gui, Show
Return
ButtonSubmit:
Gui, Submit, NoHide
If StrLen(Guess) != 4
Return
If Guess is not digit
Return
bulls:=0, cows:=0
Loop, 4
If (SubStr(Guess, A_Index, 1) = SubStr(Code, A_Index, 1))
bulls++
Else If InStr(Code, SubStr(Guess, A_Index, 1))
cows++
GuiControl,, History, % Guess ": " bulls " Bulls " cows " Cows"
Return
GuiClose:
ExitApp

43
Task/Caesar-cipher/ALGOL-68/caesar-cipher.alg Normal file
View file

@ -0,0 +1,43 @@
#!/usr/local/bin/a68g --script #
program caesar: BEGIN
MODE MODXXVI = SHORT SHORT INT; # MOD26 #
PROC to m26 = (CHAR c, offset)MODXXVI:
BEGIN
ABS c - ABS offset
END #to m26#;
PROC to char = (MODXXVI value, CHAR offset)CHAR:
BEGIN
REPR ( ABS offset + value MOD 26 )
END #to char#;
PROC encrypt = (STRING plain, MODXXVI key)STRING:
BEGIN
[UPB plain]CHAR ciph;
FOR i TO UPB plain DO
CHAR c = plain[i];
ciph[i]:=
IF "A" <= c AND c <= "Z" THEN
to char(to m26(c, "A")+key, "A")
ELIF "a" <= c AND c <= "z" THEN
to char(to m26(c, "a")+key, "a")
ELSE
c
FI
OD;
ciph
END #encrypt#;
# caesar main program #
STRING text := "The five boxing wizards jump quickly" # OR read string #;
MODXXVI key := 3; # Default key from "Bello Gallico" #
printf(($gl$, "Plaintext ------------>" + text));
text := encrypt(text, key);
printf(($gl$, "Ciphertext ----------->" + text));
printf(($gl$, "Decrypted Ciphertext ->" + encrypt(text, -key)))
END #caesar#

6
Task/Caesar-cipher/AutoHotkey/caesar-cipher-1.ahk Normal file
View file

@ -0,0 +1,6 @@
n=2
s=HI
t:=&s
While *t
o.=Chr(Mod(*t-65+n,26)+65),t+=2
MsgBox % o

13
Task/Caesar-cipher/AutoHotkey/caesar-cipher-2.ahk Normal file
View file

@ -0,0 +1,13 @@
Caesar(string, n){
Loop Parse, string
{
If (Asc(A_LoopField) >= Asc("A") and Asc(A_LoopField) <= Asc("Z"))
out .= Chr(Mod(Asc(A_LoopField)-Asc("A")+n,26)+Asc("A"))
Else If (Asc(A_LoopField) >= Asc("a") and Asc(A_LoopField) <= Asc("z"))
out .= Chr(Mod(Asc(A_LoopField)-Asc("a")+n,26)+Asc("a"))
Else out .= A_LoopField
}
return out
}
MsgBox % Caesar("h i", 2) "`n" Caesar("Hi", 20)

32
Task/Caesar-cipher/AutoIt/caesar-cipher.autoit Normal file
View file

@ -0,0 +1,32 @@
$Caesar = Caesar("Hi", 2, True)
MsgBox(0, "Caesar", $Caesar)
Func Caesar($String, $int, $encrypt = True)
If Not IsNumber($int) Or Not StringIsDigit($int) Then Return SetError(1, 0, 0)
If $int < 1 Or $int > 25 Then Return SetError(2, 0, 0)
Local $sLetters, $x
$String = StringUpper($String)
$split = StringSplit($String, "")
For $i = 1 To $split[0]
If Asc($split[$i]) - 64 > 26 Or Asc($split[$i]) - 64 < 1 Then
$sLetters &= $split[$i]
ContinueLoop
EndIf
If $encrypt = True Then
$move = Asc($split[$i]) - 64 + $int
Else
$move = Asc($split[$i]) - 64 - $int
EndIf
If $move > 26 Then
$move -= 26
ElseIf $move < 1 Then
$move += 26
EndIf
While $move
$x = Mod($move, 26)
If $x = 0 Then $x = 26
$sLetters &= Chr($x + 64)
$move = ($move - $x) / 26
WEnd
Next
Return $sLetters
EndFunc ;==>Caesar

108
Task/Calendar/ALGOL-68/calendar.alg Normal file
View file

@ -0,0 +1,108 @@
#!/usr/local/bin/a68g --script #
PROC print calendar = (INT year, page width)VOID: (
[]STRING month names = (
"January","February","March","April","May","June",
"July","August","September","October","November","December"),
weekday names = ("Su","Mo","Tu","We","Th","Fr","Sa");
FORMAT weekday fmt = $g,n(UPB weekday names - LWB weekday names)(" "g)$;
# Juggle the calendar format to fit the printer/screen width #
INT day width = UPB weekday names[1], day gap=1;
INT month width = (day width+day gap) * UPB weekday names-1;
INT month heading lines = 2;
INT month lines = (31 OVER UPB weekday names+month heading lines+2); # +2 for head/tail weeks #
INT year cols = (page width+1) OVER (month width+1);
INT year rows = (UPB month names-1)OVER year cols + 1;
INT month gap = (page width - year cols*month width + 1)OVER year cols;
INT year width = year cols*(month width+month gap)-month gap;
INT year lines = year rows*month lines;
MODE MONTHBOX = [month lines, month width]CHAR;
MODE YEARBOX = [year lines, year width]CHAR;
INT week start = 1; # Sunday #
PROC days in month = (INT year, month)INT:
CASE month IN 31,
IF year MOD 4 EQ 0 AND year MOD 100 NE 0 OR year MOD 400 EQ 0 THEN 29 ELSE 28 FI,
31, 30, 31, 30, 31, 31, 30, 31, 30, 31
ESAC;
PROC day of week = (INT year, month, day)INT: (
# Day of the week by Zeller’s Congruence algorithm from 1887 #
INT y := year, m := month, d := day, c;
IF m <= 2 THEN m +:= 12; y -:= 1 FI;
c := y OVER 100;
y %*:= 100;
(d - 1 + ((m + 1) * 26) OVER 10 + y + y OVER 4 + c OVER 4 - 2 * c) MOD 7
);
MODE SIMPLEOUT = UNION(STRING, []STRING, INT);
PROC cputf = (REF[]CHAR out, FORMAT fmt, SIMPLEOUT argv)VOID:(
FILE f; STRING s; associate(f,s);
putf(f, (fmt, argv));
out[:UPB s]:=s;
close(f)
);
PROC month repr = (INT year, month)MONTHBOX:(
MONTHBOX month box; FOR line TO UPB month box DO month box[line,]:=" "* 2 UPB month box OD;
STRING month name = month names[month];
# center the title #
cputf(month box[1,(month width - UPB month name ) OVER 2+1:], $g$, month name);
cputf(month box[2,], weekday fmt, weekday names);
INT first day := day of week(year, month, 1);
FOR day TO days in month(year, month) DO
INT line = (day+first day-week start) OVER UPB weekday names + month heading lines + 1;
INT char =((day+first day-week start) MOD UPB weekday names)*(day width+day gap) + 1;
cputf(month box[line,char:char+day width-1],$g(-day width)$, day)
OD;
month box
);
PROC year repr = (INT year)YEARBOX:(
YEARBOX year box;
FOR line TO UPB year box DO year box[line,]:=" "* 2 UPB year box OD;
FOR month row FROM 0 TO year rows-1 DO
FOR month col FROM 0 TO year cols-1 DO
INT month = month row * year cols + month col + 1;
IF month > UPB month names THEN
done
ELSE
INT month col width = month width+month gap;
year box[
month row*month lines+1 : (month row+1)*month lines,
month col*month col width+1 : (month col+1)*month col width-month gap
] := month repr(year, month)
FI
OD
OD;
done: year box
);
INT center = (year cols*(month width+month gap) - month gap - 1) OVER 2;
INT indent = (page width - year width) OVER 2;
printf((
$n(indent + center - 9)k g l$, "[Insert Snoopy here]",
$n(indent + center - 1)k 4d l$, year, $l$,
$n(indent)k n(year width)(g) l$, year repr(year)
))
);
main: (
CO inspired by http://www.ee.ryerson.ca/~elf/hack/realmen.html
Real Programmers Don't Use PASCAL - Ed Post
Datamation, volume 29 number 7, July 1983
THE REAL PROGRAMMER'S NATURAL HABITAT
"Taped to the wall is a line-printer Snoopy calender for the year 1969."
CO
INT mankind stepped on the moon = 1969,
line printer width = 80; # as at 1969! #
print calendar(mankind stepped on the moon, line printer width)
)

8
Task/Check-that-file-exists/Aikido/check-that-file-exists.aikido Normal file
View file

@ -0,0 +1,8 @@
function exists (filename) {
return stat (filename) != null
}
exists ("input.txt")
exists ("/input.txt")
exists ("docs")
exists ("/docs")

33
Task/Check-that-file-exists/AutoHotkey/check-that-file-exists.ahk Normal file
View file

@ -0,0 +1,33 @@
; FileExist() function examples
ShowFileExist("input.txt")
ShowFileExist("\input.txt")
ShowFolderExist("docs")
ShowFolderExist("\docs")
; IfExist/IfNotExist command examples (from documentation)
IfExist, D:\
MsgBox, The drive exists.
IfExist, D:\Docs\*.txt
MsgBox, At least one .txt file exists.
IfNotExist, C:\Temp\FlagFile.txt
MsgBox, The target file does not exist.
Return
ShowFileExist(file)
{
If (FileExist(file) && !InStr(FileExist(file), "D"))
MsgBox, file: %file% exists.
Else
MsgBox, file: %file% does NOT exist.
Return
}
ShowFolderExist(folder)
{
If InStr(FileExist(folder), "D")
MsgBox, folder: %folder% exists.
Else
MsgBox, folder: %folder% does NOT exist.
Return
}

82
Task/Classes/ALGOL-68/classes.alg Normal file
View file

@ -0,0 +1,82 @@
MODE MYDATA = STRUCT(
INT name1
);
STRUCT(
INT name2,
PROC (REF MYDATA)REF MYDATA new,
PROC (REF MYDATA)VOID init,
PROC (REF MYDATA)VOID some method
) class my data;
class my data := (
# name2 := # 2, # Class attribute #
# PROC new := # (REF MYDATA new)REF MYDATA:(
(init OF class my data)(new);
new
),
# PROC init := # (REF MYDATA self)VOID:(
""" Constructor (Technically an initializer rather than a true 'constructor') """;
name1 OF self := 0 # Instance attribute #
),
# PROC some method := # (REF MYDATA self)VOID:(
""" Method """;
name1 OF self := 1;
name2 OF class my data := 3
)
);
# class name, invoked as a function is the constructor syntax #
REF MYDATA my data = (new OF class my data)(LOC MYDATA);
MODE GENDEROPT = UNION(STRING, VOID);
MODE AGEOPT = UNION(INT, VOID);
MODE MYOTHERDATA = STRUCT(
STRING name,
GENDEROPT gender,
AGEOPT age
);
STRUCT (
INT count,
PROC (REF MYOTHERDATA, STRING, GENDEROPT, AGEOPT)REF MYOTHERDATA new,
PROC (REF MYOTHERDATA, STRING, GENDEROPT, AGEOPT)VOID init,
PROC (REF MYOTHERDATA)VOID del
) class my other data;
class my other data := (
# count := # 0, # Population of "(init OF class my other data)" objects #
# PROC new := # (REF MYOTHERDATA new, STRING name, GENDEROPT gender, AGEOPT age)REF MYOTHERDATA:(
(init OF class my other data)(new, name, gender, age);
new
),
# PROC init := # (REF MYOTHERDATA self, STRING name, GENDEROPT gender, AGEOPT age)VOID:(
""" One initializer required, others are optional (with different defaults) """;
count OF class my other data +:= 1;
name OF self := name;
gender OF self := gender;
CASE gender OF self IN
(VOID):gender OF self := "Male"
ESAC;
age OF self := age
),
# PROC del := # (REF MYOTHERDATA self)VOID:(
count OF class my other data -:= 1
)
);
PROC attribute error := STRING: error char; # mend the error with the "error char" #
# Allocate the instance from HEAP #
REF MYOTHERDATA person1 = (new OF class my other data)(HEAP MYOTHERDATA, "John", EMPTY, EMPTY);
print (((name OF person1), ": ",
(gender OF person1|(STRING gender):gender|attribute error), " ")); # "John Male" #
print (((age OF person1|(INT age):age|attribute error), new line)); # Raises AttributeError exception! #
# Allocate the instance from LOC (stack) #
REF MYOTHERDATA person2 = (new OF class my other data)(LOC MYOTHERDATA, "Jane", "Female", 23);
print (((name OF person2), ": ",
(gender OF person2|(STRING gender):gender|attribute error), " "));
print (((age OF person2|(INT age):age|attribute error), new line)) # "Jane Female 23" #

7
Task/Classes/Aikido/classes.aikido Normal file
View file

@ -0,0 +1,7 @@
class Circle (radius, x, y) extends Shape (x, y) implements Drawable {
var myvec = new Vector (x, y)
public function draw() {
// draw the circle
}
}

27
Task/Classes/AmigaE/classes.amiga Normal file
View file

@ -0,0 +1,27 @@
OBJECT a_class
varA, varP
ENDOBJECT
-> this could be used like a constructor
PROC init() OF a_class
self.varP := 10
self.varA := 2
ENDPROC
-> the special proc end() is for destructor
PROC end() OF a_class
-> nothing to do here...
ENDPROC
-> a not so useful getter
PROC getP() OF a_class IS self.varP
PROC main()
DEF obj : PTR TO a_class
NEW obj.init()
WriteF('\d\n', obj.varA) -> this can be done, while
-> varP can't be accessed directly
WriteF('\d\n', obj.varP) -> or
WriteF('\d\n', obj.getP())
END obj
ENDPROC

19
Task/Classes/AutoHotkey/classes.ahk Normal file
View file

@ -0,0 +1,19 @@
obj := new MyClass
obj.WhenCreated()
class MyClass {
; Instance Variable #1
time := A_Hour ":" A_Min ":" A_Sec
; Constructor
__New() {
MsgBox, % "Constructing new object of type: " this.__Class
FormatTime, date, , MM/dd/yyyy
; Instance Variable #2
this.date := date
}
; Method
WhenCreated() {
MsgBox, % "Object created at " this.time " on " this.date
}
}

4
Task/Collections/AutoHotkey/collections-1.ahk Normal file
View file

@ -0,0 +1,4 @@
myCol := Object()
mycol.mykey := "my value!"
mycol["mykey"] := "new val!"
MsgBox % mycol.mykey ; new val

3
Task/Collections/AutoHotkey/collections-2.ahk Normal file
View file

@ -0,0 +1,3 @@
Loop 3
array%A_Index% := A_Index * 9
MsgBox % array1 " " array2 " " array3 ; 9 18 27

4
Task/Collections/AutoHotkey/collections-3.ahk Normal file
View file

@ -0,0 +1,4 @@
VarSetCapacity(Rect, 16) ; A RECT is a struct consisting of four 32-bit integers (i.e. 4*4=16).
DllCall("GetWindowRect", UInt, WinExist(), UInt, &Rect) ; WinExist() returns an HWND.
MsgBox % "Left " . NumGet(Rect, 0, true) . " Top " . NumGet(Rect, 4, true)
. " Right " . NumGet(Rect, 8, true) . " Bottom " . NumGet(Rect, 12, true)

3
Task/Color-of-a-screen-pixel/Applesoft-BASIC/color-of-a-screen-pixel-1.bas Normal file
View file

@ -0,0 +1,3 @@
X = PDL (0) * 5 / 32
Y = PDL (1) * 3 / 16
COLOR= SCRN( X,Y)

41
Task/Color-of-a-screen-pixel/Applesoft-BASIC/color-of-a-screen-pixel-2.bas Normal file
View file

@ -0,0 +1,41 @@
100 REM GET HCOLOR
110 REM PARAMETERS: X Y
120 REM RETURNS: C
130 REM
140 P = 0:X = X + 1
150 ON (X < 280) GOSUB 300
160 PR = P:P = 0:X = X - 2
170 ON (X > = 0) GOSUB 300
180 PL = P:X = X + 1: GOSUB 300
190 ODD = X - INT (X / 2) * 2
200 C = H * 4
210 IF NOT ((PL = PR) AND (PL < > P)) THEN C = C + P * 3: RETURN
220 IF ODD THEN P = NOT P
230 C = C + P + 1
240 RETURN
250 REM
260 REM GET PIXEL
270 REM PARAMETERS: X Y
280 REM RETURNS: H P
290 REM
300 H = INT (X / 7)
310 V = INT (Y / 8)
320 VO = PEEK (37)
330 HO = PEEK (36)
340 VTAB V + 1: HTAB 1
350 A = PEEK (41) * 256
360 A = A + PEEK (40) + H
370 VTAB VO + 1: HTAB HO + 1
380 A = A + 8192 - 1024
390 P = PEEK (230) / 32
400 IF P = 2 THEN A = A + 8192
410 A = A + (Y - V * 8) * 1024
420 B = X - H * 7
430 V = PEEK (A)
440 H = INT (V / 128)
450 V = INT (V / (2 ^ B))
460 P = V - INT (V / 2) * 2
470 RETURN
X = 267 : Y = 166 : GOSUB 100
HCOLOR= C

1
Task/Color-of-a-screen-pixel/AutoHotkey/color-of-a-screen-pixel.ahk Normal file
View file

@ -0,0 +1 @@
PixelGetColor, color, %X%, %Y%

2
Task/Color-of-a-screen-pixel/AutoIt/color-of-a-screen-pixel.autoit Normal file
View file

@ -0,0 +1,2 @@
$a = Mousegetpos()
PixelGetColor($a[0], $a[1])

1
Task/Comments/6502-Assembly/comments.6502 Normal file
View file

@ -0,0 +1 @@
nop ; comments begin with a semicolon

2
Task/Comments/8086-Assembly/comments.8086 Normal file
View file

@ -0,0 +1,2 @@
MOV AX, 4C00h ; go back to DOS
INT 21h ; BIOS interrupt 21 base 16

3
Task/Comments/AmigaE/comments.amiga Normal file
View file

@ -0,0 +1,3 @@
/* multiline comment
are like C ... */
-> this is a end of line comment

5
Task/Comments/AutoHotkey/comments.ahk Normal file
View file

@ -0,0 +1,5 @@
Msgbox, comments demo ; end of line comment
/*
multiline comment1
multiline comment2
*/

5
Task/Comments/AutoIt/comments.autoit Normal file
View file

@ -0,0 +1,5 @@
#cs
Everything between the cs and and the ce is commented.
Commented code is not used by the computer.
#ce
;individual lines after a semicolon are commented.

161
Task/Define-a-primitive-data-type/ALGOL-68/define-a-primitive-data-type.alg Normal file
View file

@ -0,0 +1,161 @@
# assume max int <= ABS - max negative int #
INT max bounded = ( LENG max int * max int > long max int | ENTIER sqrt(max int) | max int );
MODE RANGE = STRUCT(INT lwb, upb);
MODE BOUNDED = STRUCT(INT value, RANGE range);
FORMAT bounded repr = $g"["g(-0)":"g(-0)"]"$;
# Define some useful operators for looping over ranges #
OP LWB = (RANGE range)INT: lwb OF range,
UPB = (RANGE range)INT: upb OF range,
LWB = (BOUNDED bounded)INT: lwb OF range OF bounded,
UPB = (BOUNDED bounded)INT: upb OF range OF bounded;
PROC raise exception = ([]STRING args)VOID: (
put(stand error, ("exception: ",args, newline));
stop
);
PROC raise not implemented error := ([]STRING args)VOID: raise exception(args);
PROC raise bounds error := ([]STRING args)VOID: raise exception(args);
PRIO MIN=9, MAX=9;
OP MIN = ([]INT list)INT: (
INT out:= list[LWB list];
FOR index FROM LWB list+1 TO UPB list DO IF list[index]<out THEN out :=list[index] FI OD;
out
);
OP MAX = ([]INT list)INT: (
INT out:= list[LWB list];
FOR index FROM LWB list+1 TO UPB list DO IF list[index]>out THEN out :=list[index] FI OD;
out
);
PRIO ASSERTIN = 6;
OP ASSERTIN = (INT result, []RANGE range)BOUNDED: (
BOUNDED out = (result, (MAX lwb OF range, MIN upb OF range));
IF value OF out < lwb OF range OF out THEN
raise bounds error(("out of bounds", whole(result, int width)," < [",whole(MAX lwb OF range, int width),":]"))
ELIF value OF out > upb OF range OF out THEN
raise bounds error(("out of bounds", whole(result, int width)," > [:",whole(MIN upb OF range, int width),"]"))
FI;
out
),
ASSERTIN = (LONG INT result, []RANGE range)BOUNDED: (
STRUCT (LONG INT value, RANGE range) out = (result, (MAX lwb OF range, MIN upb OF range));
IF value OF out < lwb OF range OF out THEN
raise bounds error(("out of bounds", whole(result, long int width)," < [",whole(MAX lwb OF range, int width),":]"))
ELIF value OF out > upb OF range OF out THEN
raise bounds error(("out of bounds", whole(result, long int width)," > [:",whole(MIN upb OF range, int width),"]"))
FI;
(SHORTEN value OF out, range OF out)
),
ASSERTIN = (INT result, []BOUNDED bounds)BOUNDED: result ASSERTIN range OF bounds,
ASSERTIN = (LONG INT result, []BOUNDED bounds)BOUNDED: result ASSERTIN range OF bounds;
INT half max int = max int OVER 2;
INT sqrt max int = ENTIER sqrt (max int);
OP + = (BOUNDED a, b)BOUNDED:
IF ABS value OF a < half max int AND ABS value OF b < half max int THEN
value OF a + value OF b ASSERTIN []BOUNDED(a,b)
ELSE
LENG value OF a + value OF b ASSERTIN []BOUNDED(a,b)
FI,
- = (BOUNDED a, b)BOUNDED: value OF a + -value OF b ASSERTIN []BOUNDED(a,b),
* = (BOUNDED a, b)BOUNDED:
IF ABS value OF a < sqrt max int AND ABS value OF b < sqrt max int THEN
value OF a * value OF b ASSERTIN []BOUNDED(a,b)
ELSE
LENG value OF a * value OF b ASSERTIN []BOUNDED(a,b)
FI,
/ = (BOUNDED a, b)REAL: value OF a / value OF b,
% = (BOUNDED a, b)BOUNDED: value OF a % value OF b ASSERTIN []BOUNDED(a,b),
%* = (BOUNDED a, b)BOUNDED: value OF a %* value OF b ASSERTIN []BOUNDED(a,b),
** = (BOUNDED a, INT exponent)BOUNDED: value OF a ** exponent ASSERTIN []BOUNDED(a);
OP OVER = (INT value, RANGE range)BOUNDED:
IF ABS lwb OF range > max bounded THEN
raise bounds error(("out of bounds, ABS", whole(lwb OF range, int width)," > [:",whole(max bounded, int width),"]"));
SKIP
ELIF ABS upb OF range > max bounded THEN
raise bounds error(("out of bounds, ABS", whole(upb OF range, int width)," > [:",whole(max bounded, int width),"]"));
SKIP
ELSE
value ASSERTIN []RANGE(range)
FI;
OP INTINIT = (BOUNDED range)REAL: value OF range;
OP < = (BOUNDED a, b)BOOL: value OF a < value OF b,
> = (BOUNDED a, b)BOOL: value OF a > value OF b,
<= = (BOUNDED a, b)BOOL: NOT ( value OF a > value OF b ),
>= = (BOUNDED a, b)BOOL: NOT ( value OF a < value OF b ),
= = (BOUNDED a, b)BOOL: value OF a = value OF b,
/= = (BOUNDED a, b)BOOL: NOT (a = b);
# Monadic operators #
OP - = (BOUNDED range)BOUNDED: -value OF range ASSERTIN []BOUNDED(range),
ABS = (BOUNDED range)BOUNDED: ABS value OF range ASSERTIN []BOUNDED(range);
COMMENT Operators for extended characters set, and increment/decrement:
OP +:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a + b ),
+=: = (BOUNDED a, REF BOUNDED b)REF BOUNDED: ( b := a + b ),
-:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a - b ),
*:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a * b ),
%:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a % b ),
%*:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a %* b );
# OP aliases for extended character sets (eg: Unicode, APL, ALCOR and GOST 10859) #
OP × = (BOUNDED a, b)BOUNDED: a * b,
÷ = (BOUNDED a, b)INT: a OVER b,
÷× = (BOUNDED a, b)BOUNDED: a MOD b,
÷* = (BOUNDED a, b)BOUNDED: a MOD b,
%× = (BOUNDED a, b)BOUNDED: a MOD b,
≤ = (BOUNDED a, b)BOUNDED: a <= b,
≥ = (BOUNDED a, b)BOUNDED: a >= b,
≠ = (BOUNDED a, b)BOOL: a /= b,
↑ = (BOUNDED range, INT exponent)BOUNDED: value OF range ** exponent,
÷×:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a MOD b ),
%×:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a MOD b ),
÷*:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a MOD b );
# BOLD aliases for CPU that only support uppercase for 6-bit bytes - wrist watches #
OP OVER = (BOUNDED a, b)INT: a % b,
MOD = (BOUNDED a, b)BOUNDED: a %*b,
LT = (BOUNDED a, b)BOOL: a < b,
GT = (BOUNDED a, b)BOOL: a > b,
LE = (BOUNDED a, b)BOOL: a <= b,
GE = (BOUNDED a, b)BOOL: a >= b,
EQ = (BOUNDED a, b)BOOL: a = b,
NE = (BOUNDED a, b)BOOL: a /= b,
UP = (BOUNDED range, INT exponent)BOUNDED: range**exponent;
# the required standard assignment operators #
OP PLUSAB = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a +:= b ), # PLUS #
PLUSTO = (BOUNDED a, REF BOUNDED b)REF BOUNDED: ( a +=: b ), # PRUS #
MINUSAB = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a *:= b ),
DIVAB = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a /:= b ),
OVERAB = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a %:= b ),
MODAB = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a %*:= b );
END COMMENT
Test:
RANGE range = RANGE(0, 10000);
# override the default exception #
raise bounds error := ([]STRING args)VOID: (
putf(stand error, ($g$, args, $"- exiting to except bounds error"l$));
except bounds error
);
BOUNDED a, b := 0 OVER range;
FOR step FROM 4 BY 4 TO UPB range DO # something for pythagoras #
b := b + step OVER range;
a := ENTIER sqrt( 1.5 + 2 * value OF b ) OVER range OF b;
printf(($"Sum of "$, bounded repr, a * a, b * b,
$" is "$, bounded repr, a * a + b * b, $l$))
OD;
except bounds error:
SKIP

23
Task/Delegates/Aikido/delegates.aikido Normal file
View file

@ -0,0 +1,23 @@
class Delegator {
public generic delegate = none
public function operation {
if (typeof(delegate) == "none") {
return "default implementation"
}
return delegate()
}
}
function thing {
return "delegate implementation"
}
// default, no delegate
var d = new Delegator()
println (d.operation())
// delegate
var d1 = new Delegator()
d1.delegate = thing
println (d1.operation())

17
Task/Delete-a-file/ALGOL-68/delete-a-file.alg Normal file
View file

@ -0,0 +1,17 @@
main:(
PROC remove = (STRING file name)INT:
BEGIN
FILE actual file;
INT errno = open(actual file, file name, stand back channel);
IF errno NE 0 THEN stop remove FI;
scratch(actual file); # detach the book and burn it #
errno
EXIT
stop remove:
errno
END;
remove("input.txt");
remove("/input.txt");
remove("docs");
remove("/docs")
)

4
Task/Delete-a-file/Aikido/delete-a-file.aikido Normal file
View file

@ -0,0 +1,4 @@
remove ("input.txt")
remove ("/input.txt")
remove ("docs")
remove ("/docs")

4
Task/Delete-a-file/AutoHotkey/delete-a-file.ahk Normal file
View file

@ -0,0 +1,4 @@
FileDelete, input.txt
FileDelete, \input.txt
FileRemoveDir, docs, 1
FileRemoveDir, \docs, 1

26
Task/Detect-division-by-zero/ALGOL-68/detect-division-by-zero.alg Normal file
View file

@ -0,0 +1,26 @@
PROC raise exception= ([]STRING args)VOID: (
put(stand error, ("Exception: ",args, newline));
stop
);
PROC raise zero division error := VOID:
raise exception("integer division or modulo by zero");
PROC int div = (INT a,b)REAL: a/b;
PROC int over = (INT a,b)INT: a%b;
PROC int mod = (INT a,b)INT: a%*b;
BEGIN
OP / = (INT a,b)REAL: ( b = 0 | raise zero division error; SKIP | int div (a,b) );
OP % = (INT a,b)INT: ( b = 0 | raise zero division error; SKIP | int over(a,b) );
OP %* = (INT a,b)INT: ( b = 0 | raise zero division error; SKIP | int mod (a,b) );
PROC a different handler = VOID: (
put(stand error,("caught division by zero",new line));
stop
);
INT x:=1, y:=0;
raise zero division error := a different handler;
print(x/y)
END

10
Task/Detect-division-by-zero/Applesoft-BASIC/detect-division-by-zero.bas Normal file
View file

@ -0,0 +1,10 @@
100 REM TRY
110 ONERR GOTO 200
120 D = - 44 / 0
190 END
200 REM CATCH
210 E = PEEK (222) < > 133
220 POKE 216,0: REM ONERR OFF
230 IF E THEN RESUME
240 CALL - 3288: REM RECOVER
250 PRINT "DIVISION BY ZERO"

8
Task/Detect-division-by-zero/AutoHotkey/detect-division-by-zero.ahk Normal file
View file

@ -0,0 +1,8 @@
ZeroDiv(num1, num2) {
If ((num1/num2) != "")
MsgBox % num1/num2
Else
MsgBox, 48, Warning, The result is not valid (Divide By Zero).
}
ZeroDiv(0, 3) ; is ok
ZeroDiv(3, 0) ; divize by zero alert

26
Task/Determine-if-a-string-is-numeric/ALGOL-68/determine-if-a-string-is-numeric.alg Normal file
View file

@ -0,0 +1,26 @@
PROC is numeric = (REF STRING string) BOOL: (
BOOL out := TRUE;
PROC call back false = (REF FILE f)BOOL: (out:= FALSE; TRUE);
FILE memory;
associate(memory, string);
on value error(memory, call back false);
on logical file end(memory, call back false);
UNION (INT, REAL, COMPL) numeric:=0.0;
# use a FORMAT pattern instead of a regular expression #
getf(memory, ($gl$, numeric));
out
);
test:(
STRING
s1 := "152",
s2 := "-3.1415926",
s3 := "Foo123";
print((
s1, " results in ", is numeric(s1), new line,
s2, " results in ", is numeric(s2), new line,
s3, " results in ", is numeric(s3), new line
))
)

2
Task/Determine-if-a-string-is-numeric/APL/determine-if-a-string-is-numeric.apl Normal file
View file

@ -0,0 +1,2 @@
⊃⎕VFI{w←⍵⋄((w='-')/w)←'¯'⋄w}'152 -3.1415926 Foo123'
1 1 0

12
Task/Determine-if-a-string-is-numeric/AutoHotkey/determine-if-a-string-is-numeric.ahk Normal file
View file

@ -0,0 +1,12 @@
list = 0 .14 -5.2 ten 0xf
Loop, Parse, list, %A_Space%
MsgBox,% IsNumeric(A_LoopField)
Return
IsNumeric(x) {
If x is number
Return, 1
Else Return, 0
}
;Output: 1 1 1 0 1

79
Task/FizzBuzz/6502-Assembly/fizzbuzz.6502 Normal file
View file

@ -0,0 +1,79 @@
.lf fzbz6502.lst
.cr 6502
.tf fzbz6502.obj,ap1
;------------------------------------------------------
; FizzBuzz for the 6502 by barrym95838 2013.04.04
; Thanks to sbprojects.com for a very nice assembler!
; The target for this assembly is an Apple II with
; mixed-case output capabilities and Applesoft
; BASIC in ROM (or language card)
; Tested and verified on AppleWin 1.20.0.0
;------------------------------------------------------
; Constant Section
;
FizzCt = 3 Fizz Counter (must be < 255)
BuzzCt = 5 Buzz Counter (must be < 255)
Lower = 1 Loop start value (must be 1)
Upper = 100 Loop end value (must be < 255)
CharOut = $fded Specific to the Apple II
IntOut = $ed24 Specific to ROM Applesoft
;======================================================
.or $0f00
;------------------------------------------------------
; The main program
;
main ldx #Lower init LoopCt
lda #FizzCt
sta Fizz init FizzCt
lda #BuzzCt
sta Buzz init BuzzCt
next ldy #0 reset string pointer (y)
dec Fizz LoopCt mod FizzCt == 0?
bne noFizz yes:
lda #FizzCt
sta Fizz restore FizzCt
ldy #sFizz-str point y to "Fizz"
jsr puts output "Fizz"
noFizz dec Buzz LoopCt mod BuzzCt == 0?
bne noBuzz yes:
lda #BuzzCt
sta Buzz restore BuzzCt
ldy #sBuzz-str point y to "Buzz"
jsr puts output "Buzz"
noBuzz dey any output yet this cycle?
bpl noInt no:
txa save LoopCt
pha
lda #0 set up regs for IntOut
jsr IntOut output itoa(LoopCt)
pla
tax restore LoopCt
noInt ldy #sNL-str
jsr puts output "\n"
inx increment LoopCt
cpx #Upper+1 LoopCt >= Upper+1?
bcc next no: loop back
rts yes: end main
;------------------------------------------------------
; Output zero-terminated string @ (str+y)
; (Entry point is puts, not outch)
;
outch jsr CharOut output string char
iny advance string ptr
puts lda str,y get a string char
bne outch output and loop if non-zero
rts return
;------------------------------------------------------
; String literals (in '+128' ascii, Apple II style)
;
str: ; string base offset
sFizz .az -"Fizz"
sBuzz .az -"Buzz"
sNL .az -#13
;------------------------------------------------------
; Variable Section
;
Fizz .da #0
Buzz .da #0
;------------------------------------------------------
.en

88
Task/FizzBuzz/8086-Assembly/fizzbuzz.8086 Normal file
View file

@ -0,0 +1,88 @@
; Init the registers
mov dx,03030h ; For easier printing, the number is
;kept in Binary Coded Decimal, in
----
;the DX register.
mov ah,0Eh ; 0Eh is the IBM PC interrupt 10h
;function that does write text on
;the screen in teletype mode.
mov bl,100d ; BL is the counter (100 numbers).
xor cx,cx ; CX is a counter that will be used
;for screen printing.
xor bh,bh ; BH is the counter for counting
;multiples of three.
writeloop: ; Increment the BCD number in DX.
inc dl ; Increment the low digit
cmp dl,3Ah ; If it does not overflow nine,
jnz writeloop1 ;continue with the program,
mov dl,30h ;otherwise reset it to zero and
inc dh ;increment the high digit
writeloop1:
inc bh ; Increment the BH counter.
cmp bh,03h ; If it reached three, we did
;increment the number three times
;from the last time the number was
;a multiple of three, so the number
;is now a multiple of three now,
jz writefizz ;then we need to write "fizz" on the
;screen.
cmp dl,30h ; The number isn't a multiple of
jz writebuzz ;three, so we check if it's a
cmp dl,35h ;multiple of five. If it is, we
jz writebuzz ;need to write "buzz". The program
;checks if the last digit is zero or
;five.
mov al,dh ; If we're here, there's no need to
int 10h ;write neither "fizz" nor "buzz", so
mov al,dl ;the program writes the BCD number
int 10h ;in DX
writespace:
mov al,020h ;and a white space.
int 10h
dec bl ; Loop if we didn't process 100
jnz writeloop ;numbers.
programend: ; When we did reach 100 numbers,
cli ;the program flow falls here, where
hlt ;interrupts are cleared and the
jmp programend ;program is stopped.
writefizz: ; There's need to write "fizz":
mov si,offset fizz ; SI points to the "fizz" string,
call write ;that is written on the screen.
xor bh,bh ; BH, the counter for computing the
;multiples of three, is cleared.
cmp dl,30h ; We did write "fizz", but, if the
jz writebuzz ;number is a multiple of five, we
cmp dl,35h ;could need to write "buzz" also:
jnz writespace ;check if the number is multiple of
;five. If not, write a space and
;return to the main loop.
writebuzz: ; (The above code falls here if
;the last digit is five, otherwise
;it jumps)
mov si,offset buzz ;SI points to the "buzz" string,
call write ;that is written on the screen.
jmp writespace ; Write a space to return to the main
;loop.
write: ; Write subroutine:
mov cl,04h ; Set CX to the lenght of the string:
;both strings are 4 bytes long.
write1:
mov al,[si] ; Load the character to write in AL.
inc si ; Increment the counter SI.
int 10h ; Call interrupt 10h, function 0Eh to
;write the character and advance the
;text cursor (teletype mode)
loop write1 ; Decrement CX: if CX is not zero, do
ret ;loop, otherwise return from
;subroutine.
fizz: ;The "fizz" string.
db "fizz"
buzz: ;The "buzz" string.
db "buzz"

15
Task/FizzBuzz/ALGOL-68/fizzbuzz-1.alg Normal file
View file

@ -0,0 +1,15 @@
main:(
FOR i TO 100 DO
printf(($gl$,
IF i %* 15 = 0 THEN
"FizzBuzz"
ELIF i %* 3 = 0 THEN
"Fizz"
ELIF i %* 5 = 0 THEN
"Buzz"
ELSE
i
FI
))
OD
)

1
Task/FizzBuzz/ALGOL-68/fizzbuzz-2.alg Normal file
View file

@ -0,0 +1 @@
FOR i TO 100 DO print(((i%*15=0|"FizzBuzz"|:i%*3=0|"Fizz"|:i%*5=0|"Buzz"|i),new line)) OD

2
Task/FizzBuzz/APL/fizzbuzz.apl Normal file
View file

@ -0,0 +1,2 @@
⎕IO←0
(L,'Fizz' 'Buzz' 'FizzBuzz')[¯1+(L×W=0)+W←(100×~0=W)+W←⊃+/1 2×0=3 5|⊂L←1+⍳100]

14
Task/FizzBuzz/AppleScript/fizzbuzz.applescript Normal file
View file

@ -0,0 +1,14 @@
property outputText: ""
repeat with i from 1 to 100
if i mod 15 = 0 then
set outputText to outputText & "FizzBuzz"
else if i mod 3 = 0 then
set outputText to outputText & "Fizz"
else if i mod 5 = 0 then
set outputText to outputText & "Buzz"
else
set outputText to outputText & i
end if
set outputText to outputText & linefeed
end repeat
outputText

15
Task/FizzBuzz/Arbre/fizzbuzz.arbre Normal file
View file

@ -0,0 +1,15 @@
fizzbuzz():
for x in [1..100]
if x%5==0 and x%3==0
return "FizzBuzz"
else
if x%3==0
return "Fizz"
else
if x%5==0
return "Buzz"
else
return x
main():
fizzbuzz() -> io

14
Task/FizzBuzz/AutoHotkey/fizzbuzz-1.ahk Normal file
View file

@ -0,0 +1,14 @@
Loop, 100
{
If (Mod(A_Index, 15) = 0)
output .= "FizzBuzz`n"
Else If (Mod(A_Index, 3) = 0)
output .= "Fizz`n"
Else If (Mod(A_Index, 5) = 0)
output .= "Buzz`n"
Else
output .= A_Index "`n"
}
FileDelete, output.txt
FileAppend, %output%, output.txt
Run, cmd /k type output.txt

7
Task/FizzBuzz/AutoHotkey/fizzbuzz-2.ahk Normal file
View file

@ -0,0 +1,7 @@
Gui, Add, Edit, r20
Gui,Show
Loop, 100
Send, % (!Mod(A_Index, 15) ? "FizzBuzz" : !Mod(A_Index, 3) ? "Fizz" : !Mod(A_Index, 5) ? "Buzz" : A_Index) "`n"
Return
Esc::
ExitApp

11
Task/FizzBuzz/AutoIt/fizzbuzz.autoit Normal file
View file

@ -0,0 +1,11 @@
For $i = 1 To 100
If Mod($i, 15) = 0 Then
MsgBox(0, "FizzBuzz", "FizzBuzz")
ElseIf Mod($i, 5) = 0 Then
MsgBox(0, "FizzBuzz", "Buzz")
ElseIf Mod($i, 3) = 0 Then
MsgBox(0, "FizzBuzz", "Fizz")
Else
MsgBox(0, "FizzBuzz", $i)
EndIf
Next

420
Task/Forest-fire/6502-Assembly/forest-fire.6502 Normal file
View file

@ -0,0 +1,420 @@
ORG $4357
; SYS 17239 or CALL 17239
EMPTY2 = $00
TREE2 = $44
FIRE2 = $99
; common available zero page
GBASL = $26
GBASH = $27
SEED2 = $28
SEED0 = $29
SEED1 = $2A
H2 = $2B
V2 = $2C
PLOTC = $2D
COLOR = $2E
PAGE = $2F
TOPL = $30
TOPH = $31
MIDL = $32
MIDH = $33
BTML = $34
BTMH = $35
PLOTL = $36
PLOTH = $37
lastzp = $38
tablelo = $5000
tablehi = tablelo+25
JSR START
STA V2
LDA #$4C ; JMP instruction
STA SEED2 ; temporary JMP
LDX #$00 ; y coord
table:
TXA
JSR SEED2 ; temporary JMP GBASCALC
LDA GBASL
STA tablelo,X
LDA GBASH
STA tablehi,X
LDY #$00
TYA
clrline:
STA (GBASL),Y
INY
CPY #40
BNE clrline
INX
CPX V2
BNE table
JSR sseed0
JSR sseed2
LDX #$60
STX PAGE
STX TOPH
LDY #$00
STY TOPL
TYA
zero: STA (TOPL),Y
INY
BNE zero
INX
STX TOPH
CPX #$80
BNE zero
loop3:
LDX #0
STX TOPL
LDA #41
STA MIDL
STA PLOTL
LDA #83
STA BTML
LDA PAGE
STA TOPH
STA MIDH
STA BTMH
EOR #$10
STA PLOTH
STA PAGE
loop2:
TXA
STX V2
LSR ; F800 PLOT-like...
; PHP ; F801
TAY ; save A in Y without touching C
LDA #$0F
BCC over2
ADC #$E0
over2: STA PLOTC ; PLOT...
LDA tablelo,Y ; lookup instead of GBASCALC
STA GBASL
LDA tablehi,Y
STA GBASH
; PLP ; continue PLOT
LDY #$01 ; x coord
loop1:
STY H2
LDA (MIDL),Y
STA (PLOTL),Y
BEQ empty
BPL tree
LDA #EMPTY2
doplot: LDY H2
STA (PLOTL),Y
DEY
EOR (GBASL),Y
AND PLOTC
EOR (GBASL),Y
STA (GBASL),Y
noplot:
LDY H2
INY
CPY #41
BNE loop1
LDA MIDL
STA TOPL
LDA MIDH
STA TOPH
LDA BTML
STA MIDL
STA PLOTL
CLC
ADC #42
STA BTML
LDA BTMH
EOR #$10
STA PLOTH
EOR #$10
STA MIDH
ADC #$00
STA BTMH
LDX V2
INX
CPX #48
BNE loop2
JSR QUIT
JMP loop3
empty:
DEC SEED2
BNE noplot
JSR sseed2 ; probability f
LDA #TREE2
BNE doplot
ignite:
LDA #FIRE2
BNE doplot
tree:
DEC SEED0
BNE check
DEC SEED1
BNE check
JSR sseed0 ; probability p
BNE ignite
check:
LDA (TOPL),Y ; n
ORA (BTML),Y ; s
DEY
ORA (TOPL),Y ; nw
ORA (MIDL),Y ; w
ORA (BTML),Y ; sw
INY
INY
ORA (TOPL),Y ; ne
ORA (MIDL),Y ; e
ORA (BTML),Y ; se
BMI ignite
BPL noplot
sseed0:
LDA #$17 ; 1 in 10007 (prime)
STA SEED0
LDA #$27
STA SEED1
RTS
sseed2:
LDA #$65 ; 1 in 101 (prime)
STA SEED2
RTS
default:
LDA #<GBASCALC ; setup GBASCALC
STA SEED0
LDA #>GBASCALC
STA SEED1
LDA #25 ; screen rows
RTS
GBASCALC:
LDY #$00
STY GBASH
ASL
ASL
ASL
STA GBASL
ASL
ROL GBASH
ASL
ROL GBASH
ADC GBASL
STA GBASL
LDA GBASH
ADC #$04
STA GBASH
RTS
QUIT:
LDA $E000
; APPLE II
CMP #$4C
BNE c64quit
BIT $C000 ; apple ii keypress?
BPL CONTINUE ; no keypressed then continue
BIT $C010 ; clear keyboard strobe
BIT $C051 ; text mode
; end APPLE II specific
ABORT:
PLA
PLA
LDX #GBASL
restorzp:
LDA $5100,X
STA $00,X
INX
CPX #lastzp
BNE restorzp
CONTINUE:
RTS
START:
LDX #GBASL
savezp:
LDA $00,X
STA $5100,X
INX
CPX #lastzp
BNE savezp
; machine ???
LDA $E000 ; terribly unreliable, oh well
; APPLE II
CMP #$4C ; apple ii?
BNE c64start ; nope, try another
BIT $C056 ; low resolution
BIT $C052 ; full screen
BIT $C054 ; page one
BIT $C050 ; graphics
; GBASCALC = $F847
LDA #$47
STA SEED0
LDA #$F8
STA SEED1
LDA #24 ; screen rows
RTS
; end APPLE II specific
; COMMODORE 64 specific
c64quit:
; COMMODORE 64
CMP #$85 ; commodore 64?
BNE CONTINUE ; nope, default to no keypress
LDA $C6 ; commodore keyboard buffer length
BEQ CONTINUE ; no keypressed then continue
LDA #$00
STA $C6
LDA $D016 ; Screen control register #2
AND #$EF ; Bit #4: 0 = Multicolor mode off.
STA $D016
LDA #21 ; default character set
STA $D018
BNE ABORT
c64start:
CMP #$85 ; commodore 64?
BEQ c64yes ; yes
JMP default ; no, default to boringness
c64yes:
LDA #$00 ; black
STA $D020 ; border
LDA #$00 ; black
STA $D021 ; background
LDA #$05 ; dark green
STA $D022 ; Extra background color #1
LDA #$08 ; orange
STA $D023 ; Extra background color #2
LDA $D016 ; Screen control register #2
ORA #$10 ; Bit #4: 1 = Multicolor mode on.
STA $D016
LDA #$30 ; 0011 0000 $3000 charset page
STA PLOTH
LSR
LSR
STA PLOTC ; 0000 1100 #$0C
; 53272 $D018
; POKE 53272,(PEEK(53272)AND240)+12: REM SET CHAR POINTER TO MEM. 12288
; Bits #1-#3: In text mode, pointer to character memory
; (bits #11-#13), relative to VIC bank, memory address $DD00
; %110, 6: $3000-$37FF, 12288-14335.
LDA $D018
AND #$F0
ORA PLOTC
STA $D018
; setup nine characters
; 00- 00 00
LDA #$00 ; chr(0) * 8
STA PLOTL
; --- LDA #$00 ; already zero
TAX ; LDX #$00
JSR charset
; 04- 00 55
LDA #32 ; chr(4) * 8
STA PLOTL
LDA #$55
; LDX #$00 ; already zero
JSR charset
; 09- 00 AA
LDA #72 ; chr(9) * 8
STA PLOTL
LDA #$AA
; LDX #$00 ; already zero
JSR charset
; 40- 55 00
LDA PLOTH ; 512 = chr(64) * 8
CLC
ADC #$02
STA PLOTH
LDX #$00
STX PLOTL
LDA #$00
LDX #$55
JSR charset
; 44- 55 55
LDA #32 ; chr(68) * 8
STA PLOTL
TXA ; LDA #$55
; LDX #$55 ; already 55
JSR charset
; 49- 55 AA
LDA #72 ; chr(73) * 8
STA PLOTL
LDA #$AA
; LDX #$55 ; already 55
JSR charset
; 90- AA 00
LDA PLOTH ; chr(144) * 8
CLC
ADC #$02
STA PLOTH
LDA #128
STA PLOTL
LDA #$00
LDX #$AA
JSR charset
; 94- AA 55
LDA #160 ; chr(148) * 8
STA PLOTL
LDA #$55
; LDX #$AA ; already AA
JSR charset
; 99- AA AA
LDA #200 ; chr(153) * 8
STA PLOTL
TXA ; LDA #$AA
; LDX #$AA ; already AA
JSR charset
JMP default
charset:
LDY #$00
chartop:
STA (PLOTL),Y
INY
CPY #$04
BNE chartop
TXA
charbtm:
STA (PLOTL),Y
INY
CPY #$08
BNE charbtm
RTS
; end COMMODORE 64 specific

59
Task/Forest-fire/ALGOL-68/forest-fire.alg Normal file
View file

@ -0,0 +1,59 @@
LONG REAL tree prob = 0.55, # original tree probability #
f prob = 0.01, # new combustion probability #
p prob = 0.01; # tree creation probability #
MODE CELL = CHAR; CELL empty=" ", tree="T", burning="#";
MODE WORLD = [6, 65]CELL;
PROC has burning neighbours = (WORLD world, INT r, c)BOOL:(
FOR row shift FROM -1 TO 1 DO
FOR col shift FROM -1 TO 1 DO
INT rs = r + row shift, cs = c + col shift;
IF rs >= LWB world AND rs <= UPB world AND
cs >= 2 LWB world AND cs <= 2 UPB world THEN
IF world[rs, cs] = burning THEN true exit FI
FI
OD
OD;
FALSE EXIT
true exit: TRUE
);
PROC next state = (REF WORLD world, REF WORLD next world)VOID:(
FOR r FROM LWB world TO UPB world DO
REF[]CELL row = world[r, ];
FOR c FROM LWB row TO UPB row DO
REF CELL elem = row[c];
next world[r, c] :=
IF elem = empty THEN
IF random<p prob THEN tree ELSE empty FI
ELIF elem = tree THEN
IF has burning neighbours(world, r, c) THEN
burning
ELSE
IF random<f prob THEN burning ELSE tree FI
FI
ELIF elem = burning THEN
empty
FI
OD
OD;
world := next world
);
main:(
WORLD world; # create world #
FOR r FROM LWB world TO UPB world DO
REF []CELL row = world[r, ];
FOR i FROM LWB row TO UPB row DO
REF CELL el = row[i];
el := IF random < tree prob THEN tree ELSE empty FI
OD
OD;
WORLD next world;
FOR i FROM 0 TO 4 DO
next state(world, next world);
printf(($n(2 UPB world)(a)l$, world)); # show world #
printf(($gl$, 2 UPB world * "-"))
OD
)

152
Task/Forest-fire/AutoHotkey/forest-fire.ahk Normal file
View file

@ -0,0 +1,152 @@
; The array Frame1%x%_%y% holds the current frame. frame2%x%_%y%
; is then calculated from this, and printed. frame2 is then copied to frame1.
; Two arrays are necessary so that each cell advances at the same time
; T=Tree, #=Fire, O=Empty cell
; Size holds the width and height of the map and is used as the # of iterations in loops
; This will save the map as forest_fire.txt in its working directory
; ======================================================================================
Size := 10
Generation := 0
Tree := "T"
Fire := "#"
Cell := "O"
; --Define probabilities--
New_Tree := 5
; 20 percent chance (1 in 5). A random number will be generated from 1 to New_tree. If this number is 1,
; A tree will be created in the current cell
Spontaneous := 10
; 10 percent chance (1 in 10). A random number will be generated from 1 to Spontaneous. If this number is 1,
; and the current cell contains a tree, the tree in the current cell will become fire.
GoSub, Generate
; ----------------------Main Loop------------------------------
loop
{
Generation++
GoSub, Calculate
GoSub, Copy
GoSub, Display
msgbox, 4, Forest Fire, At Generation %generation%. Continue?
IfMsgbox, No
ExitApp
}
return
; -------------------------------------------------------------
Generate: ; Randomly initializes the map.
loop % size ; % forces expression mode.
{
x := A_Index
Loop % size
{
Y := A_Index
Random, IsTree, 1, 2 ; -- Roughly half of the spaces will contain trees
If ( IsTree = 1 )
Frame1%x%_%y% := Tree
Else
Frame1%x%_%y% := Cell
}
}
return
Calculate:
Loop % size
{
x := A_Index
Loop % size
{
Y := A_Index
If ( Frame1%x%_%y% = Cell )
{
Random, tmp, 1, New_Tree
If ( tmp = 1 )
Frame2%x%_%y% := tree
Else
Frame2%x%_%y% := Cell
}
Else If ( Frame1%x%_%y% = Tree )
{
BoolCatch := PredictFire(x,y)
If (BoolCatch)
Frame2%x%_%y% := Fire
Else
Frame2%x%_%y% := Tree
}
Else If ( Frame1%x%_%y% = Fire )
Frame2%x%_%y% := Cell
Else
{
contents := Frame1%x%_%y%
Msgbox Error! Cell %x% , %y% contains %contents% ; This has never happened
ExitApp
}
}
}
return
Copy:
Loop % size
{
x := A_Index
Loop % size
{
y := A_Index
frame1%x%_%y% := Frame2%x%_%y%
}
}
return
Display:
ToPrint := ""
ToPrint .= "=====Generation " . Generation . "=====`n"
Loop % size
{
x := A_Index
Loop % size
{
y := A_Index
ToPrint .= Frame1%x%_%y%
}
ToPrint .= "`n"
}
FileAppend, %ToPrint%, Forest_Fire.txt
Return
PredictFire(p_x,p_y){
Global ; allows access to all frame1*_* variables (the pseudo-array)
A := p_x-1
B := p_y-1
C := p_x+1
D := p_y+1
If ( Frame1%A%_%p_Y% = fire )
return 1
If ( Frame1%p_X%_%B% = fire )
return 1
If ( Frame1%C%_%p_Y% = fire )
return 1
If ( Frame1%p_X%_%D% = fire )
return 1
If ( Frame1%A%_%B% = Fire )
return 1
If ( Frame1%A%_%D% = fire )
return 1
If ( Frame1%C%_%B% = fire )
return 1
If ( Frame1%C%_%D% = Fire )
return 1
Random, tmp, 1, spontaneous
if ( tmp = 1 )
return 1
return 0
}

7
Task/Infinity/ALGOL-68/infinity.alg Normal file
View file

@ -0,0 +1,7 @@
printf(($"max int: "gl$,max int));
printf(($"long max int: "gl$,long max int));
printf(($"long long max int: "gl$,long long max int));
printf(($"max real: "gl$,max real));
printf(($"long max real: "gl$,long max real));
printf(($"long long max real: "gl$,long long max real));
printf(($"error char: "gl$,error char))

3
Task/Infinity/Argile/infinity.argile Normal file
View file

@ -0,0 +1,3 @@
use std
printf "%f\n" atof "infinity" (: this prints "inf" :)
#extern :atof<text>: -> real

23
Task/JSON/ANTLR/json.antlr Normal file
View file

@ -0,0 +1,23 @@
// Parse JSON
//
// Nigel Galloway - April 27th., 2012
//
grammar JSON ;
@members {
String Indent = "";
}
Number : (('0')|('-'? ('1'..'9') ('0'..'9')*)) ('.' ('0'..'9')+)? (('e'|'E') ('+'|'-')? ('0'..'9')+)?;
WS : (' ' | '\t' | '\r' |'\n') {skip();};
Tz : ' ' .. '!' | '#' .. '[' | ']' .. '~';
Control : '\\' ('"'|'\\'|'/'|'b'|'f'|'n'|'r'|'t'|UCode);
UCode : 'u' ('0'..'9'|'a'..'f'|'A'..'F') ('0'..'9'|'a'..'f'|'A'..'F') ('0'..'9'|'a'..'f'|'A'..'F') ('0'..'9'|'a'..'f'|'A'..'F');
Keyword : 'true' | 'false' | 'null';
String : '"' (Control? Tz)* '"';
object : '{' {System.out.println(Indent + "{Object}"); Indent += " ";} (pair (',' pair*)*)? '}' {Indent = Indent.substring(4);};
pair : e = String {System.out.println(Indent + "{Property}\t" + $e.text);} ':' value;
value : Number {System.out.println(Indent + "{Number} \t" + $Number.text);}
| object
| String {System.out.println(Indent + "{String} \t" + $String.text);}
| Keyword {System.out.println(Indent + "{Keyword} \t" + $Keyword.text);}
| array;
array : '[' {System.out.println(Indent + "Array"); Indent += " ";} (value (',' value)*)? ']' {Indent = Indent.substring(4);};

14
Task/Knuth-shuffle/ALGOL-68/knuth-shuffle-1.alg Normal file
View file

@ -0,0 +1,14 @@
PROC between = (INT a, b)INT :
(
ENTIER (random * ABS (b-a+1) + (a<b|a|b))
);
PROC knuth shuffle = (REF[]INT a)VOID:
(
FOR i FROM LWB a TO UPB a DO
INT j = between(LWB a, UPB a);
INT t = a[i];
a[i] := a[j];
a[j] := t
OD
);

6
Task/Knuth-shuffle/ALGOL-68/knuth-shuffle-2.alg Normal file
View file

@ -0,0 +1,6 @@
main:(
[20]INT a;
FOR i FROM 1 TO 20 DO a[i] := i OD;
knuth shuffle(a);
print(a)
)

14
Task/Knuth-shuffle/AppleScript/knuth-shuffle-1.applescript Normal file
View file

@ -0,0 +1,14 @@
set n to 25
set array to {}
repeat with i from 1 to n
set end of array to i
end repeat
copy {array, array} to {unshuffled, shuffled}
repeat with i from n to 1 by -1
set j to (((random number) * (i - 1)) as integer) + 1
set shuffled's item i to array's item j
if j ≠ i's contents then set array's item j to array's item i
end repeat
return {unshuffled, shuffled}

2
Task/Knuth-shuffle/AppleScript/knuth-shuffle-2.applescript Normal file
View file

@ -0,0 +1,2 @@
{{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25},
{14, 25, 3, 1, 12, 18, 11, 20, 16, 15, 21, 5, 22, 19, 2, 24, 8, 10, 13, 6, 17, 23, 9, 7, 4}}

13
Task/Knuth-shuffle/AutoHotkey/knuth-shuffle.ahk Normal file
View file

@ -0,0 +1,13 @@
MsgBox % shuffle("1,2,3,4,5,6,7,8,9")
MsgBox % shuffle("1,2,3,4,5,6,7,8,9")
shuffle(list) { ; shuffle comma separated list, converted to array
StringSplit a, list, `, ; make array (length = a0)
Loop % a0-1 {
Random i, A_Index, a0 ; swap item 1,2... with a random item to the right of it
t := a%i%, a%i% := a%A_Index%, a%A_Index% := t
}
Loop % a0 ; construct string from sorted array
s .= "," . a%A_Index%
Return SubStr(s,2) ; drop leading comma
}

25
Task/Knuth-shuffle/AutoIt/knuth-shuffle.autoit Normal file
View file

@ -0,0 +1,25 @@
Dim $a[10]
ConsoleWrite('array before permutation:' & @CRLF)
For $i = 0 To 9
$a[$i] = Random(20,100,1)
ConsoleWrite($a[$i] & ' ')
Next
ConsoleWrite(@CRLF)
_Permute($a)
ConsoleWrite('array after permutation:' & @CRLF)
For $i = 0 To UBound($a) -1
ConsoleWrite($a[$i] & ' ')
Next
ConsoleWrite(@CRLF)
Func _Permute(ByRef $array)
Local $random, $tmp
For $i = UBound($array) -1 To 0 Step -1
$random = Random(0,$i,1)
$tmp = $array[$random]
$array[$random] = $array[$i]
$array[$i] = $tmp
Next
EndFunc

Some files were not shown because too many files have changed in this diff Show more