June 2018 Update
This commit is contained in:
parent
ba8067c3b7
commit
22f33d4004
5278 changed files with 84726 additions and 14379 deletions
|
|
@ -0,0 +1,29 @@
|
|||
!RosettaCode: Ethiopian Multiplication
|
||||
! True BASIC v6.007
|
||||
PROGRAM EthiopianMultiplication
|
||||
DECLARE DEF FNdouble
|
||||
DECLARE DEF FNhalve
|
||||
DECLARE DEF FNeven
|
||||
|
||||
LET x = 17
|
||||
LET y = 34
|
||||
|
||||
DO
|
||||
IF FNeven(x) = 0 THEN
|
||||
LET p = p + y
|
||||
PRINT x,y
|
||||
ELSE
|
||||
PRINT x," ---"
|
||||
END IF
|
||||
|
||||
LET x = FNhalve(x)
|
||||
LET y = FNdouble(y)
|
||||
LOOP UNTIL x = 0
|
||||
PRINT " ", " ==="
|
||||
PRINT " ", p
|
||||
GET KEY done
|
||||
|
||||
DEF FNdouble(A) = A * 2
|
||||
DEF FNhalve(A) = INT(A / 2)
|
||||
DEF FNeven(A) = MOD(A+1,2)
|
||||
END
|
||||
|
|
@ -1,33 +1,18 @@
|
|||
Procedure isEven(x)
|
||||
ProcedureReturn (x & 1) ! 1
|
||||
EndProcedure
|
||||
|
||||
Procedure halveValue(x)
|
||||
ProcedureReturn x / 2
|
||||
EndProcedure
|
||||
|
||||
Procedure doubleValue(x)
|
||||
ProcedureReturn x << 1
|
||||
EndProcedure
|
||||
|
||||
Procedure EthiopianMultiply(x, y)
|
||||
Protected sum
|
||||
Print("Ethiopian multiplication of " + Str(x) + " and " + Str(y) + " ... ")
|
||||
Repeat
|
||||
If Not isEven(x)
|
||||
sum + y
|
||||
EndIf
|
||||
x = halveValue(x)
|
||||
y = doubleValue(y)
|
||||
Until x < 1
|
||||
PrintN(" equals " + Str(sum))
|
||||
ProcedureReturn sum
|
||||
EndProcedure
|
||||
|
||||
If OpenConsole()
|
||||
EthiopianMultiply(17,34)
|
||||
|
||||
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
|
||||
Input()
|
||||
CloseConsole()
|
||||
EndIf
|
||||
x = 17
|
||||
y = 34
|
||||
tot = 0
|
||||
While x >= 1
|
||||
TextWindow.Write(x)
|
||||
TextWindow.CursorLeft = 10
|
||||
If Math.Remainder(x + 1, 2) = 0 Then
|
||||
tot = tot + y
|
||||
TextWindow.WriteLine(y)
|
||||
Else
|
||||
TextWindow.WriteLine("")
|
||||
EndIf
|
||||
x = Math.Floor(x / 2)
|
||||
y = 2 * y
|
||||
EndWhile
|
||||
TextWindow.Write("=")
|
||||
TextWindow.CursorLeft = 10
|
||||
TextWindow.WriteLine(tot)
|
||||
|
|
|
|||
|
|
@ -11,26 +11,21 @@ Procedure doubleValue(x)
|
|||
EndProcedure
|
||||
|
||||
Procedure EthiopianMultiply(x, y)
|
||||
Protected sum, sign = x
|
||||
|
||||
Print("Ethiopian multiplication of " + Str(x) + " and " + Str(y) + " ...")
|
||||
Protected sum
|
||||
Print("Ethiopian multiplication of " + Str(x) + " and " + Str(y) + " ... ")
|
||||
Repeat
|
||||
If Not isEven(x)
|
||||
sum + y
|
||||
EndIf
|
||||
x = halveValue(x)
|
||||
y = doubleValue(y)
|
||||
Until x = 0
|
||||
If sign < 0 : sum * -1: EndIf
|
||||
|
||||
Until x < 1
|
||||
PrintN(" equals " + Str(sum))
|
||||
ProcedureReturn sum
|
||||
EndProcedure
|
||||
|
||||
If OpenConsole()
|
||||
EthiopianMultiply(17,34)
|
||||
EthiopianMultiply(-17,34)
|
||||
EthiopianMultiply(-17,-34)
|
||||
|
||||
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
|
||||
Input()
|
||||
|
|
|
|||
|
|
@ -1,38 +1,38 @@
|
|||
10 LET HALVE=320
|
||||
20 LET DOUBLE=340
|
||||
30 LET EVEN=360
|
||||
40 DIM L(20)
|
||||
50 DIM R(20)
|
||||
60 INPUT L(1)
|
||||
70 INPUT R(1)
|
||||
80 LET I=1
|
||||
90 PRINT L(1),R(1)
|
||||
100 IF L(I)=1 THEN GOTO 200
|
||||
110 LET I=I+1
|
||||
120 IF I>20 THEN STOP
|
||||
130 LET X=L(I-1)
|
||||
140 GOSUB HALVE
|
||||
150 LET L(I)=Y
|
||||
160 LET X=R(I-1)
|
||||
170 GOSUB DOUBLE
|
||||
180 LET R(I)=Y
|
||||
190 GOTO 90
|
||||
200 FOR K=1 TO I
|
||||
210 LET X=L(K)
|
||||
220 GOSUB EVEN
|
||||
230 IF NOT Y THEN GOTO 260
|
||||
240 LET R(K)=0
|
||||
250 PRINT AT K-1,16;" "
|
||||
260 NEXT K
|
||||
270 LET A=0
|
||||
280 FOR K=1 TO I
|
||||
290 LET A=A+R(K)
|
||||
300 NEXT K
|
||||
310 GOTO 380
|
||||
320 LET Y=INT (X/2)
|
||||
330 RETURN
|
||||
340 LET Y=X*2
|
||||
350 RETURN
|
||||
360 LET Y=X/2=INT (X/2)
|
||||
370 RETURN
|
||||
380 PRINT AT I+1,16;A
|
||||
Procedure isEven(x)
|
||||
ProcedureReturn (x & 1) ! 1
|
||||
EndProcedure
|
||||
|
||||
Procedure halveValue(x)
|
||||
ProcedureReturn x / 2
|
||||
EndProcedure
|
||||
|
||||
Procedure doubleValue(x)
|
||||
ProcedureReturn x << 1
|
||||
EndProcedure
|
||||
|
||||
Procedure EthiopianMultiply(x, y)
|
||||
Protected sum, sign = x
|
||||
|
||||
Print("Ethiopian multiplication of " + Str(x) + " and " + Str(y) + " ...")
|
||||
Repeat
|
||||
If Not isEven(x)
|
||||
sum + y
|
||||
EndIf
|
||||
x = halveValue(x)
|
||||
y = doubleValue(y)
|
||||
Until x = 0
|
||||
If sign < 0 : sum * -1: EndIf
|
||||
|
||||
PrintN(" equals " + Str(sum))
|
||||
ProcedureReturn sum
|
||||
EndProcedure
|
||||
|
||||
If OpenConsole()
|
||||
EthiopianMultiply(17,34)
|
||||
EthiopianMultiply(-17,34)
|
||||
EthiopianMultiply(-17,-34)
|
||||
|
||||
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
|
||||
Input()
|
||||
CloseConsole()
|
||||
EndIf
|
||||
|
|
|
|||
|
|
@ -1,29 +1,38 @@
|
|||
!RosettaCode: Ethiopian Multiplication
|
||||
! True BASIC v6.007
|
||||
PROGRAM EthiopianMultiplication
|
||||
DECLARE DEF FNdouble
|
||||
DECLARE DEF FNhalve
|
||||
DECLARE DEF FNeven
|
||||
|
||||
LET x = 17
|
||||
LET y = 34
|
||||
|
||||
DO
|
||||
IF FNeven(x) = 0 THEN
|
||||
LET p = p + y
|
||||
PRINT x,y
|
||||
ELSE
|
||||
PRINT x," ---"
|
||||
END IF
|
||||
|
||||
LET x = FNhalve(x)
|
||||
LET y = FNdouble(y)
|
||||
LOOP UNTIL x = 0
|
||||
PRINT " ", " ==="
|
||||
PRINT " ", p
|
||||
GET KEY done
|
||||
|
||||
DEF FNdouble(A) = A * 2
|
||||
DEF FNhalve(A) = INT(A / 2)
|
||||
DEF FNeven(A) = MOD(A+1,2)
|
||||
END
|
||||
10 LET HALVE=320
|
||||
20 LET DOUBLE=340
|
||||
30 LET EVEN=360
|
||||
40 DIM L(20)
|
||||
50 DIM R(20)
|
||||
60 INPUT L(1)
|
||||
70 INPUT R(1)
|
||||
80 LET I=1
|
||||
90 PRINT L(1),R(1)
|
||||
100 IF L(I)=1 THEN GOTO 200
|
||||
110 LET I=I+1
|
||||
120 IF I>20 THEN STOP
|
||||
130 LET X=L(I-1)
|
||||
140 GOSUB HALVE
|
||||
150 LET L(I)=Y
|
||||
160 LET X=R(I-1)
|
||||
170 GOSUB DOUBLE
|
||||
180 LET R(I)=Y
|
||||
190 GOTO 90
|
||||
200 FOR K=1 TO I
|
||||
210 LET X=L(K)
|
||||
220 GOSUB EVEN
|
||||
230 IF NOT Y THEN GOTO 260
|
||||
240 LET R(K)=0
|
||||
250 PRINT AT K-1,16;" "
|
||||
260 NEXT K
|
||||
270 LET A=0
|
||||
280 FOR K=1 TO I
|
||||
290 LET A=A+R(K)
|
||||
300 NEXT K
|
||||
310 GOTO 380
|
||||
320 LET Y=INT (X/2)
|
||||
330 RETURN
|
||||
340 LET Y=X*2
|
||||
350 RETURN
|
||||
360 LET Y=X/2=INT (X/2)
|
||||
370 RETURN
|
||||
380 PRINT AT I+1,16;A
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue