' ----- beginning : wurzel.b --------------------

' This program is copyright 1994-1996 by Daniel Seifert. It may be freely
' distributed as long as the name of the author remains in the program.
' For changes you've made or suggestions, ...,  please contact me:

' snail mail:   Daniel Seifert           (I'll probably move in middle of
'               Weissenfelser Strasse 40  1996 to Elsenborner Weg 25, still
'               12627 Berlin              Berlin, but I don't know the postal
'               GERMANY                   (something like 126??))

' via e-mail:   dseifert@hell1og.be.schule.de   (on our school computer)
'                       (  => since I am already in the 11th grade I'll
'                             leave Gymnasium (grammar school) in two
'                             years (middle of 1998) and after that I
'                             can't be contacted anymore under this address)


' history
'
'  march 1994   : ˇmultiplication module (for other purpose)
'  october 1994 : ˇfirst version  (CursorV1.7, a BASIC compiler)
'      23s

'  a thirtheen months pause

'  december '95 : ˇoptimizing     (CursorV1.7)
'       6s        ˇmultiplication module, timer and show module rewritten
'                 ˇall val->strings where val was only one char have been
'                  replaced by chr$(48+val)
'                 ˇand vice versa (speeded up unbelievable :-)
'                 ˇtimer module removed; show module directly implemented
'  january 1996 : ˇACE and QBasic (PC) conversation (Turbo Pascal failed
'       5s           due to some bugs I really couldn't catch :)
'                 ˇsome little improvements

' ˇtime check for sqr(2), 40 decimals, on a A500 with a 68000 and 1MB RAM
'  (pay attention that elapsed time of two equal runs can differ 1 second)
' ˇThe code might be a little bit weired but I'd only paid attention on
'  the speed :), although there may be other improvements possible I didn't
'  found yet.


if not wrong then begin                     ' a joke of mine

sub MultiplikationQ$ (z1$)
 l1%=len(z1$)
 erg%=0
 Zwsp$=""
 for i%=l1% to 1 step -1
  erg%=Shl(asc(mid$(z1$,i%,1))-48,1)+erg%\10' that's what I meant with weired
  Zwsp$=chr$((erg% mod 10)+48)+Zwsp$
 next
 if erg%\10 then Zwsp$="1"+Zwsp$
 MultiplikationQ$=Zwsp$
end sub

sub Multiplikation$ (z1$,z2%)
 l1%=len(z1$)
 Zwsp$=""
 erg%=0
 for i%=l1% to 1 step -1
  erg%=(asc(mid$(z1$,i%,1))-48)*z2%+erg%\10
  Zwsp$=chr$(erg% mod 10+48)+Zwsp$
 next
 if erg%>9 then Zwsp$=chr$(erg%\10+48)+Zwsp$
 Multiplikation$=Zwsp$
end sub

begin:
 defint a-z
 dim F(10)      :For r=0 to 10:F(r)=0:next
 dim Rest$(10)
 dim Text$(1,10)

 Restore
 for i=0 to 1
  for j=1 to 10
   read Text$(i,j)
  next
 next

 sprache=msgbox("Welche Sprache? / Which language?","Deutsch","English")+1
 ' I couldn't decide to split up Wurzel.b in two versions

 window 1,"Wurzel.b, by Daniel Seifert",(0,1)-(640,150),23
 ' Hey, that's great. Cursor didn't allow me to open a window with a width
 ' of 640 pixels. I always had to use 631 pixels, altough the window was
 ' then also from the most left to the most right side of the screen (HIRES)

 shortint PosResult,g,Stelle,Punkt

 cls
 prints text$(sprache,1)
 prints text$(sprache,2)
 prints
 prints text$(sprache,3)
 prints text$(sprache,4)
 prints text$(sprache,5)
 prints
 prints text$(sprache,6);:input "",z$
 prints text$(sprache,7);:input "",maxStelle  ' pay attention that if you
                                              ' use a very high (about 900-
                                              ' 1000) it doesn't fit in the
                                              ' string -> hello, guru

 y&=timer
 prints
 prints sqr(val(z$))text$(sprache,8)
 prints " ";
 laenge=len(z$)
 if laenge mod 2=1 then
  z$=" "+z$
  ++laenge
 end if
 Zwsp$=""
 u=shr(laenge,1)
 laenge=0
 InternErgebnis$=""

 repeat
  if laenge=u then
   laenge=0
   u=1
   z$="00"
   if Punkt=0 then
    prints ".";
    Punkt=1
   end if
  end if
  Zahl$=Zwsp$+mid$(z$,laenge+laenge+1,2)
  ++laenge

  Zwsp$=MultiplikationQ$(InternErgebnis$)

  w$=Zwsp$
  l3=len(Zahl$)

  --r
  for r=r to 9
   F(r)=0
   Rest$(r)=""
  next

  r=7

  raus=0
  repeat
   if r>0 then
    h$=chr$(r+48)
    a$=w$+h$
    case
     r>2:z2$=Multiplikation$(a$,r)
     r=1:z2$=a$
     r=2:z2$=MultiplikationQ$(a$)
    end case
    l2=len(z2$)
    if l3<l2 then
     PosResult=1
    else
     if l2<l3 then z2$="0"+z2$
     if l3<8 then
      Zwsp$=str$(val(Zahl$)-val(z2$))
      if left$(Zwsp$,1)="-" then
       PosResult=1
      else
       Zwsp$=right$(Zwsp$,len(Zwsp$)-1)
      end if
     else
      Zwsp$=""
      for i=l3 to 1 step -1                    ' subtraction
       a=asc(mid$(Zahl$,i,1))-48
       b=asc(mid$(z2$  ,i,1))-48+g

       if a<b then
        a=a+10
        g=1
       else
        g=0
       end if
       wert=a-b
       if wert>0 then ab=i
       Zwsp$=chr$(wert+48)+Zwsp$
      next
      if ab>1 then Zwsp$=right$(Zwsp$,l3-ab+1) ' remove leading 0s
      if g=1 then
       PosResult=1
       g=0
      end if
     end if
    end if
   else
    h$="0"
    Zwsp$=Zahl$
   end if

   F(r)=PosResult
   Rest$(r)=Zwsp$
   if PosResult then
    --r
    PosResult=0
    if F(r) then Zwsp$=Rest$(r):Raus=1
   else
    ++r
    if r=10 or F(r) then Raus=1
   End if
  until Raus=1
  prints h$;
  ++Stelle
  InternErgebnis$=Internergebnis$+h$
 until left$(Zwsp$,1)="0" or Stelle=MaxStelle
 prints
 prints text$(sprache,9)timer-y&text$(sprache,10)
 beep
 beep
 while inkey$="":wend
 window close 1
end

Text:

data " Program       : Wurzel.BAS, ACE-Version"
data " Copyright     : Daniel Seifert, 1994-1996"
data " Quellenangabe : mathem. Algorithmus entnommen aus :"
data "                 Dr. Holtmann : Mathematik Band 1 - Arithmetik"
data "                 (c) Fachbuchverlag Leipzig 1963"
data " Wurzel ziehen aus : "
data " Stellenanzahl     : "
data " (diese Zahl hat der Computer ausgerechnet (mit sqr))"
data " Benötigte Zeit : "," Sekunden"

data " Program                 : Wurzel.BAS, ACE-Version"
data " Copyright               : Daniel Seifert, 1994-1996"
data " list of acknowledgement : Mathematic algorithm taken from :"
data "                           Dr. Holtmann : Mathematik Band 1 - Arithmetik"
data "                           (c) Fachbuchverlag Leipzig 1963"
data " Square root of : "
data " Decimals       : "
data " (this is the square root the computer calculated (via sqr))"
data " Elapsed time : "," seconds"